I want to define deeply nested compositions of applicative functors. For example something like this:
{-# LANGUAGE TypeOperators #-}
import Control.Monad.Trans.Cont
import Control.Arrow (Kleisli (..))
import Data.Aeson
import Data.Aeson.Types
import Data.Functor.Compose
import Data.Functor
type Configurator = Kleisli Parser Value
type Allocator = ContT () IO
type Validator = Either String
someConfigurator :: Configurator Int
someConfigurator = undefined
someAllocator :: Allocator Char
someAllocator = undefined
-- the nested functor composition. left-associated
type Phases = Configurator `Compose` Allocator `Compose` Validator
data Foo = Foo Int Char
-- I want to streamline writing this, without spamming the Compose constructor
fooPhases :: Phases Foo
fooPhases = _
To streamline the syntax for creating the fooPhases value, I though of (ab)using QualifiedDo:
module Bind where
import Data.Functor
import Data.Functor.Compose
(>>=) :: Functor f => f a -> (a -> g b) -> Compose f g b
(>>=) f k = bindPhase f k
(>>) :: Functor f => f a -> g b -> Compose f g b
(>>) f g = Compose $ f <&> \_ -> g
fail :: MonadFail m => String -> m a
fail = Prelude.fail
bindPhase :: Functor f => f a -> (a -> g b) -> Compose f g b
bindPhase f k = Compose (f <&> k)
Somewhat to my surprise, it worked:
{-# LANGUAGE QualifiedDo #-}
import qualified Bind
fooPhases :: Phases Foo
fooPhases = Bind.do
i <- someConfigurator
c <- someAllocator
pure (Foo i c)
Alas, when I add applicative-like functions to the Bind module
return :: Applicative f => a -> f a
return = Prelude.pure
pure :: Applicative f => a -> f a
pure = Prelude.pure
fmap :: Functor f => (a -> b) -> f a -> f b
fmap = Prelude.fmap
join :: f (g a) -> Compose f g a
join = Compose
(<*>) :: (Applicative f, Applicative g) => f (a -> b) -> g a -> Compose f g b
(<*>) f g = Compose $ f <&> \z -> Prelude.fmap (z $) g
and then enable ApplicativeDo in Main, I start to get errors like the following:
* Couldn't match type: Compose (Kleisli Parser Value) (ContT () IO)
with: Kleisli Parser Value
Expected: Configurator (Compose Allocator Validator Foo)
Actual: Compose
(Kleisli Parser Value)
(ContT () IO)
(Compose Allocator Validator Foo)
Is there a way to use my Bind.do when both QualifiedDo and ApplicativeDo are enabled in Main?
To make this easier to reason about, first manually desugar fooPhases each way:
fooPhasesMonad =
someConfigurator Bind.>>= \i ->
someAllocator Bind.>>= \c ->
pure (Foo i c)
fooPhasesApplicative = Bind.fmap Foo someConfigurator Bind.<*> someAllocator
If you check their types in GHCi, you'll see that fooPhasesMonad has the type you want (as expected, since it works), but fooPhasesApplicative has type (Configurator `Compose` Allocator) Foo.
The first problem is that Bind.fmap f m isn't equivalent to m Bind.>>= (pure . f). In particular, the latter produces an extra layer of Compose but the former does not. When you use ApplicativeDo, using the former instead means you end up with just (Configurator `Compose` Allocator) instead of (Configurator `Compose` Allocator `Compose` Validator), which is the cause of your type error. To fix it, replace your definition of Bind.fmap with this one:
fmap :: (Functor f, Applicative g) => (a -> b) -> f a -> Compose f g b
fmap f k = bindPhase k (Prelude.pure . f)
The "monads" of your do-notation fail all of the monad laws, though (even the types of the results can't be right), so some rewrites that you take for granted aren't still valid. In particular, you'll still get an error unless you settle for your types being composed like this instead:
type Phases = (Configurator `Compose` Validator) `Compose` Allocator
Related
I'm having trouble understanding why there are two independent f and f0 Applicative constraints in code below (requires reducers package).
import Data.Semigroup.Applicative
import Data.Semigroup.Reducer
import Data.Semigroup
-- | Foo
--
-- >>> getMax $ foo ["abc","a","hello",""]
-- 5
foo :: [String] -> (Max Int)
foo = foldReduce . map (length)
bar :: (Foldable f, Monoid m, Reducer e m) => f e -> m
bar = foldReduce
m :: Max Int
m = unit (2 :: Int)
apm :: (Applicative f) => Ap f (Max Int)
apm = unit $ pure (2 :: Int) -- ambiguous Applicative!
I think that I need to somehow tell that I want f0 ~ f where f0 is independently inferred by use of pure.
I tried to simplify:
u :: (Applicative f, Monoid m) => e -> Ap f m
u = undefined
m :: (Applicative f) => Ap f (Max Int)
m = u $ (pure (2 :: Int))
It will compile once e is changed to f e so that contexts can "unify". But I don't know how to unify with reducer context.
My goal is to foldReduce with Applicative Semigroup (if that's possible at all) so that length will be replaced with effectful version.
The standard solution is to use ScopedTypeVariables to announce that the f in the signature for apm and the f you want pure to produce are the same f. So:
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Semigroup.Applicative
import Data.Semigroup.Reducer
import Data.Semigroup
apm :: forall f. Applicative f => Ap f (Max Int)
apm = unit (pure 2 :: f Int)
Don't lose the forall; it's a requirement of the extension to bring f into scope in the definition's body.
I have identified some common functionality in two of my datatypes, so like any programmer worth his salt I tried to factor it out:
module Binary where
import Control.Applicative
import Data.Function
import Control.Monad
class Binary f where
yes :: f a a
no :: f a b
(..>) :: f a b -> f b c -> f a c
yes' :: f a ()
(~.>) :: f a b -> f a c -> f a c
try :: (Binary f, Alternative (f a)) => f a a -> f a a
try = (<|> yes)
try' :: (Binary f, Alternative (f a)) => f a () -> f a ()
try' = (<|> yes')
(.>) :: (Binary f, Alternative (f c)) => f a c -> f c c -> f a c
a .> b = a ..> try b
(~>) :: (Binary f, Alternative (f a)) => f a b -> f a () -> f a ()
a ~> b = a ~.> try' b
greedy :: (Binary f, Alternative (f a)) => f a a -> f a a
greedy = fix $ ap (.>)
greedy' :: (Binary f, Alternative (f a)) => f a () -> f a ()
greedy' = fix $ ap (~>)
As you can see, the types of yes and yes', and ..> and ~.> are slightly different - they need to be for me to write instances - and so I end up with duplicate functions.
Is there a way I can get rid of yes' and ~.>, and still make an instance of Binary with those types?
Here are my two instances:
module Example where
import Binary
import Prelude hiding ((.), id)
import Control.Category
import Data.List.Zipper as Z
import Control.Monad.Trans.Maybe
import Control.Monad.State
newtype Opt a b = Opt { runOpt :: a -> Maybe b }
instance Category Opt where
id = yes
(Opt f) . (Opt g) = Opt $ g >=> f
instance Binary Opt where
yes = Opt Just
no = Opt $ const Nothing
(..>) = (>>>)
---------
type Tape = Zipper
newtype Machine a b = Machine { unMachine :: MaybeT (State (Tape a)) b }
instance Functor (Machine a) where
fmap f (Machine x) = Machine $ f <$> x
instance Applicative (Machine a) where
pure = Machine . pure
(Machine f) <*> (Machine x) = Machine $ f <*> x
instance Monad (Machine a) where
(Machine a) >>= f = Machine $ a >>= unMachine <$> f
instance Binary Machine where
no = Machine mzero
yes' = pure ()
a ~.> b = a >> b
I think there is a subtle inconsistency in your two instances -- that is, Opt and Machine do not quite have enough in common to share this much structure. For example, the methods
yes :: f a a
(..>) :: f a b -> f b c -> f a c
are essentially a Category, as you have noticed (though I would simply make Category a superclass of Binary instead of duplicating those methods). But Machine is not a category as it does not support composition. Also, Opt is a profunctor (contravariant in its first argument, covariant in its second), whereas Machine is instead invariant on its first argument. These are my hints that something needs to be changed before you try to abstract over these types.
My suspicion is that there is a missing parameter to Machine, and the state parameter is actually external to the Binary abstraction. Try using the Kleisli category of your monad.
newtype Machine s a b = Machine { unMachine :: a -> MaybeT (State (Tape s)) b }
Now Machine s is a Category and the same sort of Binary that Opt is, and you don't need any of the primed combinators, and you can express any old Machine a bs as Machine a () b if you need to, but you can also probably generalize them.
In fact, the abstraction you are looking for may simply be ArrowZero. Arrow has a bit more structure than Category, so you should consider whether the rest of Arrow is applicable to your problem. If so, you have just opened a new toolbox of combinators, and you don't need to write any instances by hand because they are all covered by:
type Opt = Kleisli Maybe
type Machine s = Kleisli (MaybeT (State s))
(or in newtype style with GeneralizedNewtypeDeriving if you prefer)
Suppose that I'm wanting to define a data-type indexed by two type level environments. Something like:
data Woo s a = Woo a | Waa s a
data Foo (s :: *) (env :: [(Symbol,*)]) (env' :: [(Symbol,*)]) (a :: *) =
Foo { runFoo :: s -> Sing env -> (Woo s a, Sing env') }
The idea is that env is the input environment and env' is the output one. So, type Foo acts like an indexed state monad. So far, so good. My problem is how could I show that Foo is an applicative functor. The obvious try is
instance Applicative (Foo s env env') where
pure x = Foo (\s env -> (Woo x, env))
-- definition of (<*>) omitted.
but GHC complains that pure is ill-typed since it infers the type
pure :: a -> Foo s env env a
instead of the expected type
pure :: a -> Foo s env env' a
what is completely reasonable. My point is, it is possible to define an Applicative instance for Foo allowing to change the environment type? I googled for indexed functors, but at first sight, they don't appear to solve my problem. Can someone suggest something to achieve this?
Your Foo type is an example of what Atkey originally called a parameterised monad, and everyone else (arguably incorrectly) now calls an indexed monad.
Indexed monads are monad-like things with two indices which describe a path through a directed graph of types. Sequencing indexed monadic computations requires that the indices of the two computations line up like dominos.
class IFunctor f where
imap :: (a -> b) -> f x y a -> f x y b
class IFunctor f => IApplicative f where
ipure :: a -> f x x a
(<**>) :: f x y (a -> b) -> f y z a -> f x z b
class IApplicative m => IMonad m where
(>>>=) :: m x y a -> (a -> m y z b) -> m x z b
If you have an indexed monad which describes a path from x to y, and a way to get from y to z, the indexed bind >>>= will give you a bigger computation which takes you from x to z.
Note also that ipure returns f x x a. The value returned by ipure doesn't take any steps through the directed graph of types. Like a type-level id.
A simple example of an indexed monad, to which you alluded in your question, is the indexed state monad newtype IState i o a = IState (i -> (o, a)), which transforms the type of its argument from i to o. You can only sequence stateful computations if the output type of the first matches the input type of the second.
newtype IState i o a = IState { runIState :: i -> (o, a) }
instance IFunctor IState where
imap f s = IState $ \i ->
let (o, x) = runIState s i
in (o, f x)
instance IApplicative IState where
ipure x = IState $ \s -> (s, x)
sf <**> sx = IState $ \i ->
let (s, f) = runIState sf i
(o, x) = runIState sx s
in (o, f x)
instance IMonad IState where
s >>>= f = IState $ \i ->
let (t, x) = runIState s i
in runIState (f x) t
Now, to your actual question. IMonad, with its domino-esque sequencing, is a good abstraction for computations which transform a type-level environment: you expect the first computation to leave the environment in a state which is palatable to the second. Let us write an instance of IMonad for Foo.
I'm going to start by noting that your Woo s a type is isomorphic to (a, Maybe s), which is an example of the Writer monad. I mention this because we'll need an instance for Monad (Woo s) later and I'm too lazy to write my own.
type Woo s a = Writer (First s) a
I've picked First as my preferred flavour of Maybe monoid but I don't know exactly how you intend to use Woo. You may prefer Last.
I'm also soon going to make use of the fact that Writer is an instance of Traversable. In fact, Writer is even more traversable than that: because it contains exactly one a, we won't need to smash any results together. This means we only need a Functor constraint for the effectful f.
-- cf. traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
traverseW :: Functor f => (a -> f b) -> Writer w a -> f (Writer w b)
traverseW f m = let (x, w) = runWriter m
in fmap (\x -> writer (x, w)) (f x)
Let's get down to business.
Foo s is an IFunctor. The instance makes use of Writer s's functor-ness: we go inside the stateful computation and fmap the function over the Writer monad inside.
newtype Foo (s :: *) (env :: [(Symbol,*)]) (env' :: [(Symbol,*)]) (a :: *) =
Foo { runFoo :: s -> Sing env -> (Woo s a, Sing env') }
instance IFunctor (Foo s) where
imap f foo = Foo $ \s env ->
let (woo, env') = runFoo foo s env
in (fmap f woo, env')
We'll also need to make Foo a regular Functor, to use it with traverseW later.
instance Functor (Foo s x y) where
fmap = imap
Foo s is an IApplicative. We have to use Writer s's Applicative instance to smash the Woos together. This is where the Monoid s constraint comes from.
instance IApplicative (Foo s) where
ipure x = Foo $ \s env -> (pure x, env)
foo <**> bar = Foo $ \s env ->
let (woof, env') = runFoo foo s env
(woox, env'') = runFoo bar s env'
in (woof <*> woox, env'')
Foo s is an IMonad. Surprise surprise, we end up delegating to Writer s's Monad instance. Note also the crafty use of traverseW to feed the intermediate a inside the writer to the Kleisli arrow f.
instance IMonad (Foo s) where
foo >>>= f = Foo $ \s env ->
let (woo, env') = runFoo foo s env
(woowoo, env'') = runFoo (traverseW f woo) s env'
in (join woowoo, env'')
Addendum: The thing that's missing from this picture is transformers. Instinct tells me that you should be able to express Foo as a monad transformer stack:
type Foo s env env' = ReaderT s (IStateT (Sing env) (Sing env') (WriterT (First s) Identity))
But indexed monads don't have a compelling story to tell about transformers. The type of >>>= would require all the indexed monads in the stack to manipulate their indices in the same way, which is probably not what you want. Indexed monads also don't compose nicely with regular monads.
All this is to say that indexed monad transformers play out a bit nicer with a McBride-style indexing scheme. McBride's IMonad looks like this:
type f ~> g = forall x. f x -> g x
class IMonad m where
ireturn :: a ~> m a
(=<?) :: (a ~> m b) -> (m a ~> m b)
Then monad transformers would look like this:
class IMonadTrans t where
ilift :: IMonad m => m a ~> t m a
Essentially, you're missing a constraint on Sing env' - namely that it needs to be a Monoid, because:
you need to be able to generate a value of type Sing env' from nothing (e.g. mempty)
you need to be able to combine two values of type Sing env' into one during <*> (e.g. mappend).
You'll also need to the ability combine s values in <*>, so, unless you want to import SemiGroup from somewhere, you'll probably want that to be a Monoid too.
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveFunctor #-}
module SO37860911 where
import GHC.TypeLits (Symbol)
import Data.Singletons (Sing)
data Woo s a = Woo a | Waa s a
deriving Functor
instance Monoid s => Applicative (Woo s) where
pure = Woo
Woo f <*> Woo a = Woo $ f a
Waa s f <*> Woo a = Waa s $ f a
Woo f <*> Waa s a = Waa s $ f a
Waa s f <*> Waa s' a = Waa (mappend s s') $ f a
data Foo (s :: *) (env :: [(Symbol,*)]) (env' :: [(Symbol,*)]) (a :: *) =
Foo { runFoo :: s -> Sing env -> (Woo s a, Sing env') }
deriving Functor
instance (Monoid s, Monoid (Sing env')) => Applicative (Foo s env env') where
pure a = Foo $ \_s _env -> (pure a, mempty)
Foo mf <*> Foo ma = Foo $ \s env -> case (mf s env, ma s env) of
((w,e), (w',e')) -> (w <*> w', e `mappend` e')
I'm solving some ploblem on generating ancestor instances in Haskell. Recently I found this on Haskell wiki: Class system extension proposal. So, I would like to know, are there any solutions for this proposal already?
Here are the examples from the Proposal:
The current class system in Haskell is based on the idea that you can
often provide default implementations for class methods at the same
time as defining the class, by using other methods of the class or its
ancestors. However consider the following hierarchy, adapted from
Functor hierarchy proposal and The Other Prelude:
class Functor m where
fmap :: (a -> b) -> m a -> m b
class Functor m => Applicative m where
return :: a -> m a
apply :: m (a -> b) -> m a -> m b
(>>) :: m a -> m b -> m b
ma >> mb = (fmap (const id) ma) `apply` mb
class Applicative m => Monad m where
(>>=) :: m a -> (a -> m b) -> m b
For all concrete instances of Monad we can define fmap, apply, and
(>>)in terms of return and (>>=) as follows:
fmap f ma = ma >>= (\a -> return (f a))
apply mf ma = mf >>= \f -> ma >>= \a -> return (f a)
ma >> mb = ma >>= \_ -> mb
In other words, we'd like to be able to write:
class Applicative m => Monad m where
(>>=) :: m a -> (a -> m b) -> m b
fmap f ma = ma >>= (\a -> return (f a))
apply mf ma = mf >>= \f -> ma >>= \a -> return (f a)
ma >> mb = ma >>= \_ -> mb
and be able to define new instances of Monad just by supplying
definitions for return and (>>=) by writing:
instance Monad T where
ma >>= a_mb = ... -- some definition
return a = ... -- some definition
Explicit import/export of instances
This is needed so that large programs can be built without fear of
colliding instance declarations between different packages. A possible
syntax could be:
module M
-- exported instances
( instance Monad T
, instance Functor (F a) hiding (Functor (F Int), Functor (F Char))
, F(..)
) where
import Foo (instance Monad a hiding Monad Maybe)
data T a
data F a b
where the context is elided because this isn't used in instance
selection (at the moment). The import directive tells the compiler to
use all Monad instances exported by Foo except for the Monad Maybe
instance (it doesn't matter whether or not Foo actually does export a
Monad Maybe instance - all that matters here is that we don't want it
if there is one).
Yes, the DefaultSignatures extension allows this. For example, for the Functor/Applicative example, one could write
{-# LANGUAGE DefaultSignatures #-}
class Functor f where
fmap :: (a -> b) -> f a -> f b
default fmap :: Applicative f => (a -> b) -> f a -> f b
fmap = liftA
Is it possible to implement a MonadTransControl instance for FreeT? I started with the following, but got stuck:
instance (Functor f) => MonadTransControl (FreeT f) where
newtype StT (FreeT f) r = FreeTStT r
liftWith unlift = lift $ unlift $ error "Stuck here"
restoreT inner = do
FreeTStT r <- lift inner
return r
If it is unimplementable, than why and is it possible to extend a specific free functor implementation somehow to make it implementable?
Disclaimer: turns out you need Traversable f constraint for MonadTransControl instance.
Warning: the instance in this answer does not obey all the laws of MonadTransControl
Pragmas and imports
{-# LANGUAGE TypeFamilies #-}
import qualified Data.Traversable as T
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Control
import Control.Monad.Trans.Free
import qualified Control.Monad.Free as F
Free monadic state
As I said in comments, the proper "monadic state" of FreeT f should be Free f (the one from Control.Monad.Free):
instance T.Traversable f => MonadTransControl (FreeT f) where
newtype StT (FreeT f) a = StTFreeT { getStTFreeT :: F.Free f a }
Now the implementation of restoreT changes a bit:
restoreT inner = do
StTFreeT m <- lift inner
F.toFreeT m
liftWith implementation
Before we look at the implementation let's see what should the type of liftWith be:
liftWith :: Monad m => (Run (FreeT f) -> m a) -> FreeT f m a
And Run (FreeT f) is actually
forall n b. Monad n => FreeT f n b -> n (StTFreeT f b)
So the implementation would be like that:
liftWith unlift = lift $ unlift (liftM StTFreeT . pushFreeT)
The rest is simple:
pushFreeT :: (T.Traversable f, Monad m) => FreeT f m a -> m (F.Free f a)
pushFreeT m = do
f <- runFreeT m
case f of
Pure x -> return (return x)
Free y -> liftM wrap $ T.mapM pushFreeT y
Why Traversable?
As you can see the problem is with pushFreeT function: it uses T.mapM (which is traverse but with Monad constraint). Why do we need it there? If you look at the definition of FreeT you may notice that (NB: this is rough, I forget about Pure here):
FreeT f m a ~ m (f (m (f ... )))
And as a result of pushFreeT we need m (Free f a):
m (Free f a) ~ m (f (f (f ... )))
So we need to "push" all fs to the end and join all ms in the head. Thus we need an operation that lets us push a single f through single m and this is exactly what T.mapM pushFreeT gives us:
mapM :: (Monad m, Traversable t) => (a -> m b) -> t a -> m (t b)
mapM pushFreeT :: Traversable t => t (FreeT t m a) -> m (t (Free t a))
The laws
Every class instance usually come with laws. MonadTransControl is not an exception, so let's check if they hold for this instance:
liftWith . const . return = return
liftWith (const (m >>= f)) = liftWith (const m) >>= liftWith . const . f
These two laws obviously follow from laws for MonadTrans and the definition of liftWith.
liftWith (\run -> run t) >>= restoreT . return = t
Apparently, this law does not hold. This is because monad layers in t are collapsed when we pushFreeT. So the implemented liftWith merges effects in all layers of FreeT f m leaving us with the equivalent of m (Free f).