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)
Related
I have a Bitraversable called t that supports this operation:
someName :: Monad m => (t (m a) (m b) -> c) -> m (t a b) -> c
In other words, it's possible to take a function that accepts two monads packaged into the bitraversable and turn it into a mapping that accepts a single monad containing a bitraversable without the monad layer. This is something like a bitraversable and higher-level version of distribute; the type signature is similar to this:
\f -> \x -> f (distribute x)
:: (Distributive g, Functor f) => (g (f a) -> c) -> f (g a) -> c
My questions:
Is there a standard name for this "higher-level" version of distribute that works on functions that accept distributives rather than distributives themselves?
Is there a name for the bitraversable version?
Does it work with every bitraversable/functor/monad/whatever, or are there restrictions?
As per #Noughtmare, your "higher level" functions someName and distribute are just written in continuation passing style. These generally aren't worth additional names, because they are just right function compositions:
highLevelDistribute = (. distribute)
Practically speaking, anywhere you want to call highLevelDistribute on an argument:
highLevelDistribute f
this expression is equivalent to:
f . distribute
and even if you're using highLevelDistribute as a first-class value, it's just not that hard to write and understand the section (. distribute).
Note that traverse and sequenceA are a little different, since we have:
sequenceA = traverse id
You could make an argument that this difference doesn't really warrant separate names either, but that's an argument for another day.
Getting back to someName, it's a CPS version of:
someOtherName :: m (t a b) -> t (m a) (m b)
which looks like a bifunctor analogue of distribute:
distribute :: (Distributive g, Functor f) => f (g a) -> g (f a)
So, I'd suggest inventing a Bidistributive to reflect this, and someOtherName becomes bidistribute:
class Bifunctor g => Bidistributive g where
{-# MINIMAL bidistribute | bicollect #-}
bidistribute :: Functor f => f (g a b) -> g (f a) (f b)
bidistribute = bicollect id
bicollect :: Functor f => (a -> g b c) -> f a -> g (f b) (f c)
bicollect f = bidistribute . fmap f
Again, your "higher level" someName is just right-composition:
someName = (. bidistribute)
Reasonable laws for a Bidistributive would probably include the following. I'm not sure if these are sufficiently general and/or exhaustive:
-- naturality
bimap (fmap f) (fmap g) . bidistribute = bidistribute . fmap (bimap f g)
-- identity
bidistribute . Identity = bimap Identity Identity
-- composition
bimap Compose Compose . bidistribute . fmap bidistribute = bidistribute . Compose
For your question #3, not all Bitraversables are Bidistributive, for much the same reason that not all Traversables are Distributive. A Distributive allows you to "expose structure" under an arbitrary functor. So, for example, there's no Distributive instance for lists, because if there was, you could call:
distribute :: IO [a] -> [IO a]
which would allow you to determine if a list returned by an IO action was empty or not, without executing the IO action.
Similarly, Either is Bitraversable, but it can't be Bidistributive, because if it was, you'd be able to use:
bidistribute :: IO (Either a b) -> Either (IO a) (IO b)
to determine if the IO action returned a Left or Right without having to execute the IO action.
One interesting thing about bidistribute is that the "other functor" can be any Functor; it doesn't need to be an Applicative. So, just as we have:
sequenceA :: (Traversable t, Applicative f) => t (f a) -> f (t a)
distribute :: (Distributive g, Functor f) => f (g a) -> g (f a)
we have:
bisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)
bidistribute :: (Bidistributive g, Functor f) => f (g a b) -> g (f a) (f b)
Intuitively, sequencing needs the power of an applicative functor f to be able to "build" the f (t a) from a traversal of its functorial f a "parts", while distribution only needs to take the f (g a) apart. In practical terms, this means that sequencing typically looks like this:
-- specialized to t ~ []
sequenceA :: [f a] -> f [a]
sequenceA (f:fs) = (:) <$> f <*> fs -- need applicative operations
while distribution typically looks like this:
-- specialized to g ~ (->) r
distribute :: f (r -> a) -> (r -> f a)
distribute f r = fmap ($ r) f -- only need fmap
(Technically, according to the documentation for Data.Distributive, the Distributive class only requires a Functor rather than some coapplicative class because of the lack of non-trivial comonoids in Haskell. See this SO answer.)
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
I'm trying to write an instance of Applicative for my datatype
data Multinode k v = Multinode { key :: k
, values :: [v]
} deriving Show
data Multimap k v = Multimap [Multinode k v] deriving Show
I'm still learning Haskell. So I may make funny mistakes. If I understood properly, Applicative is a subset of Functor. The operators that have to be defined are pure and <*>.
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
My attempt is the following
instance Applicative (Multimap k) where
pure x = Multimap [(Multinode x [x])]
(Multimap mf#((Multinode kf vsf):nsf)) <*> (Multimap mx#((Multinode kx vsx):nsx)) =
Multimap [Multinode kf (vsf <*> vsx)]
Maps and multimaps are not naturally Applicative. Here's why: you need
pure
:: (...) -- Possible constraint involving k, but not v
=> v -> MultiMap k v
Since there are no constraints on v, pure cannot use its argument to generate any keys. So the set of keys in the result must always be the same, which doesn't work out for any meaningful notion of <*> that I know of.
The semigroupoids package offers a class called Apply, which is much more promising:
class Functor f => Apply f where
(<.>) :: f (a -> b) -> f a -> f b
liftF2 :: (a -> b -> c) -> f a -> f b -> f c
(.>) :: f a -> f b -> f b
(<.) :: f a -> f b -> f a
This is just like Applicative but without pure. <.> is analogous to <*>, liftF2 is analogous to liftA2, etc. The semigroupoids package includes an instance Ord k => Apply (Map k). You should be able to think of a couple different instances for your type based on the general idea of that one.
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
I would like to have a function for either mapping a pure function to a container or sequencing applicative/monadic action through it. For pure mapping we have
fmap :: Functor f => (a -> b) -> (f a -> f b)
For monadic sequencing we have (from Data.Taversable)
mapM :: (Traversable f, Monad m) => (a -> m b) -> (f a -> m (f b))
Which is similar to
mapKleisli :: (Traversable f, Monad m) => Kleisli m a b -> Kleisli m (f a) (f b)
mapKleisli = Kleisli . mapM . runKleisli
We know both (->) and (Kleisli m) are categories (and arrows). So it's naturally to make a generalization:
mapCategory :: (X f, Category c) => c a b -> c (f a) (f b)
Do you know such a class X with similar method? Maybe, somewhere on hackage? I tried to hoogle/hayoo but haven't found anything appropriate.
Update:
Now I know better what I need. Both Kleisli arrows and (->) are instances of ArrowApply which is as powerful as Monad. I came up with this arrow-based version of Travesable:
{-# LANGUAGE TypeOperators #-}
import Prelude hiding (id, (.), mapM)
import Control.Arrow
import Control.Category
class Traversable f where
traverse :: ArrowApply (~>) => f a -> (a ~> b) ~> f b
mapArrow :: (ArrowApply (~>), Traversable f) => a ~> b -> f a ~> f b
mapArrow a = arr (\x -> (traverse x, a)) >>> app
instance Traversable Maybe where
traverse Nothing = arr (const Nothing)
traverse (Just x) = arr (\a -> (a, x)) >>> app >>> arr Just
instance Traversable [] where
traverse [] = arr (const [])
traverse (x : xs) = undefined -- this is hard!
I could use just usual Applicative-based Traversable, with Identity for pure functions, but I'm not sure it is good. Considering pure functions as special case of monadic actions is weird. Interpreting both pure functions and monadic actions as instances of some action class (Category/Arrow/ArrowApply) looks more straightforward to me.
Questions: would you like to finish instance for []? Has my opinion about ArrowApply vs Monad any sense?
You're asking for "some class X", but it should be pretty clear that the most (or perhaps, only) correct name for this class would be "Functor". What you want is simply a functor class defined for an arbitrary Category instance, rather than limited to (->).
Of course, your definition is still limited to (endo)functors from a category to a subcategory defined by the type constructor giving the instance. If you generalize a bit further, there's no reason for the two categories to be the same, giving you a type class something like this one:
class (Category r, Category t) => Functor f r t | f r -> t, f t -> r where
fmap :: r a b -> t (f a) (f b)
This is still awfully limited vs. the full concept of a functor in category theory, but oh well.
It's also interesting to observe that this still has a (->) type constructor in it--that's because, even though we're modeling the source and target categories with arbitrary instances, the whole thing (and in particular, the functor itself) still exists in some sense in Hask, i.e., the category associated with (->). The other half of the functor (the part mapping objects) is, roughly speaking, the (->) in the kind * -> * for the type constructor f.