Fusing traversals - haskell

The Traversable Paper gives an example on page 18-19 of fusing monoidal and monadic traversals which sounds really interesting but I'm confused by their LaTex.
cciBody :: Char -> Count a
wciBody :: Char -> (|M| (State Bool) DotInASquare Count) a
With the amazing result that:
(traverse cciBody) xInACircle (traverse wciBody)
Is the same as:
traverse (cciBody xInACircle wciBody)
I think the type of that result is:
Count XInASquare (|M| (State Bool) DotInASquare Count) [a]
But not 100% sure. Could someone who speaks Emoji tell me how it should look in Haskell?
Update
I think xInACircle might be an infix sequenceA. The types kind of match up. Or maybe it's just (,) which is an instance of Traversable. It's definitely not <*> even though the result looks a bit like t (x <*> y) = t x <*> t y but they don't use a Wingding for <*> in the paper.
Update 2
The type of xInACircle is (Functor m, Functor n) ⇒ (a → m b) → (a → n b) → (a → (m XInASquare n) b). Remind you of anything? Not me.

You're getting confused about operators used in type signatures. Basically, the same rules from Haskell syntax hold for these: first priority is parentheses, second priority is "application", last priority is "operators". So just as you might write:
f 3 + g 4
[which in mathematical terms we'd write as f(3) + g(4)], in Haskell there is a flag to enable infix type operators (-XTypeOperators) beginning with colons, so that you can write an expression like f :: a :* b -> b :* [a] in place of f :: Star a b -> Star b [a]. It's just an alternative syntax for a parametric type constructor with at least two parameters. (I guess since -> is already an infix type constructor this is hardly news.) We can also write these as Comp a b and Prod a b.
The up-arrows and down-arrows are functions defined within the paper as part of a type class, but I don't like all of the pragmas that we need in order for Haskell to actually accept those functions, so I'm going to explicate them in this code. Here are all of the relevant definitions as a valid Haskell file using Comp and Prod instead of their operators:
import Control.Applicative (Applicative, (<$>), (<*>), pure, WrappedMonad(..), Const(..))
import Data.Traversable (traverse)
import Control.Monad.State.Lazy (State, state, runState)
import Data.Char (isSpace)
import Data.Monoid (Monoid(..))
instance Monoid Integer where
mempty = 0
mappend = (+)
-- chained functors
newtype Comp m n a = Comp {runComp :: m (n a)}
instance (Functor m, Functor n) => Functor (Comp m n) where
fmap f = Comp . fmap (fmap f) . runComp
instance (Applicative m, Applicative n) => Applicative (Comp m n) where
pure = Comp . pure . pure
Comp mnf <*> Comp mnx = Comp ((<*>) <$> mnf <*> mnx)
-- outer product of functors
data Prod m n a = Prod {pfst :: m a, psnd :: n a}
instance (Functor m, Functor n) => Functor (Prod m n) where
fmap f (Prod ma na) = Prod (fmap f ma) (fmap f na)
instance (Applicative m, Applicative n) => Applicative (Prod m n) where
pure x = Prod (pure x) (pure x)
Prod mf nf <*> Prod mx nx = Prod (mf <*> mx) (nf <*> nx)
-- page 19,20
type Count = Const Integer
count :: a -> Count b
count _ = Const 1
cciBody :: Char -> Count a
cciBody = count
cci :: String -> Count [a]
cci = traverse cciBody
test :: Bool -> Integer
test b = if b then 1 else 0
lciBody :: Char -> Count a
lciBody c = Const (test (c == '\n'))
lci :: String -> Count [a]
lci = traverse lciBody
wciBody :: Char -> Comp (WrappedMonad (State Bool)) Count a
wciBody c = Comp (fmap Const (WrapMonad $ state $ updateState c)) where
updateState :: Char -> Bool -> (Integer, Bool)
updateState c w = let s = not (isSpace c) in (test (not w && s), s)
wci :: String -> Comp (WrappedMonad (State Bool)) Count [a]
wci = traverse wciBody
runWci :: String -> Integer
runWci s = fst $ runState (fmap getConst $ unwrapMonad $ runComp $ wci s) False
If you're not clear where any functions come from I've restricted the imports up-top, so look up there (or use Hoogle) to find their definitions.
The operator you're calling xInACircle is an operator which takes an a -> m b and an a -> n b and produces a function a -> Prod m n b. This product type contains both results of both applicatives m and n. Once you understand the x-in-a-square type you'll understand the x-in-a-circle operator. Basically unlike the (Monoid m) => Applicative ((,) m) instance, which only fmaps and <*>s over its second argument, the Prod of two abstract-functors is a pair-functor which fmaps and <*>s over both its arguments. It is the pair (m a, n a) where both m and n are applicative.

Related

Trying to implement "the essence of the iterator pattern"

I came across the paper "https://www.cs.ox.ac.uk/jeremy.gibbons/publications/iterator.pdf" which has code examples in quite an abstract pseudo haskell syntax.
I'm struggeling to implement the example from section 6.2. in real haskell.
This is how far I came:
module Iterator where
import Data.Functor.Const -- for Const
import Data.Monoid (Sum (..), getSum) -- for Sum
import Control.Monad.State.Lazy -- for State
import Control.Applicative -- for WrappedMonad
data Prod m n a = Prod {pfst:: m a, psnd:: n a} deriving (Show)
instance (Functor m, Functor n) => Functor (Prod m n) where
fmap f (Prod m n) = Prod (fmap f m) (fmap f n)
instance (Applicative m, Applicative n) => Applicative (Prod m n) where
pure x = Prod (pure x) (pure x)
mf <*> mx = Prod (pfst mf <*> pfst mx) (psnd mf <*> psnd mx)
-- Functor Product
x :: (Functor m, Functor n) => (a -> m b) -> (a -> n b) -> (a -> Prod m n b)
(f `x` g) y = Prod (f y) (g y)
type Count = Const (Sum Integer)
count :: a -> Count b
count _ = Const 1
cciBody :: Char -> Count a
cciBody = count
cci :: String -> Count [a]
cci = traverse cciBody
lciBody :: Char -> Count a
lciBody c = Const (Sum $ test (c == '\n'))
test :: Bool -> Integer
test b = if b then 1 else 0
lci :: String -> Count [a]
lci = traverse lciBody
clci :: String -> Prod Count Count [a]
clci = traverse (cciBody `x` lciBody)
-- up to here the code is working
-- can't get this to compile:
wciBody :: Char -> (WrappedMonad (Prod (State Bool) Count)) a
wciBody c = pure $ state (updateState c) where
updateState :: Char -> Bool -> (Integer, Bool)
updateState c w = let s = c /= ' ' in (test (not(w && s)), s)
wci :: String -> (WrappedMonad (Prod (State Bool) Count)) [a]
wci = traverse wciBody
clwci :: String -> (Prod (Prod Count Count) (WrappedMonad (Prod (State Bool) Count))) [a]
clwci = traverse (cciBody `x` lciBody `x` wciBody)
str :: [Char]
str = "hello \n nice \t and \n busy world"
iteratorDemo = do
print $ clci str
print $ clwci str
The problematic spot is wciBody where I have no idea how to implement the ⇑ function from the paper.
Any ideas?
I think you may be mis-translating between the infix type operators used in the paper with the prefix type constructors in your definitions. I say this because the paper contains
wciBody :: Char → (𝕄 (State Bool) ⊡ Count) a
You have translated this as
wciBody :: Char -> (WrappedMonad (Prod (State Bool) Count)) a
which I don't think makes sense: Prod x y has no Monad instance, so it makes no sense to wrap it in WrapMonad. Rather, you are intended to read the ⊡ character as separating its entire left half (𝕄 (State Bool)) from its right half (Count), similar to how value-level operators in Haskell parse:
wciBody :: Char -> Prod (WrappedMonad (State Bool)) Count a
This makes more sense, doesn't it? Prod now takes three arguments, the first two of which are each of kind * -> *, and WrappedMonad's argument is clearly a monad. Does this change get you back on track?
Thanks to the hint by amalloy I finally got the example code working.
Here is what I came up with:
module Iterator where
import Data.Functor.Product -- Product of Functors
import Data.Functor.Compose -- Composition of Functors
import Data.Functor.Const -- Const Functor
import Data.Functor.Identity -- Identity Functor (needed for coercion)
import Data.Monoid (Sum (..), getSum) -- Sum Monoid for Integers
import Control.Monad.State.Lazy -- State Monad
import Control.Applicative -- WrappedMonad
import Data.Coerce (coerce) -- Coercion magic
-- Functor Product
(<#>) :: (Functor m, Functor n) => (a -> m b) -> (a -> n b) -> (a -> Product m n b)
(f <#> g) y = Pair (f y) (g y)
-- Functor composition
(<.>) :: (Functor m, Functor n) => (b -> n c) -> (a -> m b) -> (a -> (Compose m n) c)
f <.> g = Compose . fmap f . g
type Count = Const (Sum Integer)
count :: a -> Count b
count _ = Const 1
cciBody :: Char -> Count a
cciBody = count
cci :: String -> Count [a]
cci = traverse cciBody
lciBody :: Char -> Count a
lciBody c = Const $ test (c == '\n')
test :: Bool -> Sum Integer
test b = Sum $ if b then 1 else 0
lci :: String -> Count [a]
lci = traverse lciBody
clci :: String -> Product Count Count [a]
clci = traverse (cciBody <#> lciBody)
wciBody :: Char -> Compose (WrappedMonad (State Bool)) Count a
wciBody c = coerce (updateState c) where
updateState :: Char -> Bool -> (Sum Integer, Bool)
updateState c w = let s = not(isSpace c) in (test (not w && s), s)
isSpace :: Char -> Bool
isSpace c = c == ' ' || c == '\n' || c == '\t'
wci :: String -> Compose (WrappedMonad (State Bool)) Count [a]
wci = traverse wciBody
clwci :: String -> (Product (Product Count Count) (Compose (WrappedMonad (State Bool)) Count)) [a]
clwci = traverse (cciBody <#> lciBody <#> wciBody)
-- | the actual wordcount implementation.
-- for any String a triple of linecount, wordcount, charactercount is returned
wc :: String -> (Integer, Integer, Integer)
wc str =
let raw = clwci str
cc = coerce $ pfst (pfst raw)
lc = coerce $ psnd (pfst raw)
wc = coerce $ evalState (unwrapMonad (getCompose (psnd raw))) False
in (lc,wc,cc)
pfst :: Product f g a -> f a
pfst (Pair fst _) = fst
psnd :: Product f g a -> g a
psnd (Pair _ snd) = snd
main = do
putStrLn "computing three counters in one go"
print $ wc "hello \n world"

Haskell Write Monad for expressions

I am trying to design embedded language, where operations can raise certain flags depending on values. I foresee operation on scalar values as well as on vectors (e.g. map, fold, etc.) My idea is to use Writer Monad to keep track of flags. Simplified example, where actual type is "Int" and flag is raised if any of argument is 0.
import Control.Monad.Identity
import Control.Monad.Writer
import Data.Monoid
type WInt = Writer Any Int
bplus :: Int -> Int -> WInt
bplus a b =
do
tell (Any (a == 0 || b == 0)) ;
return (a+b)
wbplus :: WInt -> WInt -> WInt
wbplus wa wb =
do
a <- wa ;
b <- wb ;
tell (Any (a == 0 || b == 0)) ;
return (a+b)
ex0 = runWriter (bplus 1 2)
ex1 = runWriter (bplus 0 2)
ex2 = runWriter (wbplus (return 1) (return 2))
ex3 = runWriter (wbplus (return 0) (return 2))
ex4 = runWriter (wbplus (wbplus (return 1) (return 2)) (return 2))
ex5 = runWriter (wbplus (wbplus (return 0) (return 2)) (return 2))
ex6 = runWriter (wbplus (wbplus (return 1) (return 2)) (return 0))
I am little unsure what is the best way to implement this. Some questions:
Should I define all operations like I did for bplus or like for wbplus. Laters makes composition easier, it seems. But to use foldM binary operator should have type Int -> Int -> WInt.
What would be the appropriate type for lists: Writer Any [Int] or [Wint]?
Any suggestions or thoughts are appreciated.
You can derive bplus from wbplus and vice versa using the appropriate monadic operations:
import Control.Monad
apM2 :: Monad m => (a -> b -> m c) -> m a -> m b -> m c
apM2 f ma mb = do
a <- ma
b <- mb
f a b
pureM2 :: Monad m => (m a -> m b -> m c) -> a -> b -> m c
pureM2 f a b = f (return a) (return b)
They are inverses of each other, evident from the type signatures of their compositions:
ghci> :t pureM2 . apM2
pureM2 . apM2 :: Monad m => (a -> b -> m c) -> a -> b -> m c
ghci> :t apM2 . pureM2
apM2 . pureM2 :: Monad m => (m a -> m b -> m c) -> m a -> m b -> m c
Now you can define wbplus = apM2 bplus or bplus = pureM2 wbplus. There's no definite answer which one is better, use your taste and judgement. TemplateHaskell goes with the wbplus approach and defines all operations to work with values in the Q monad. See Language.Haskell.TH.Lib.
Regarding [m a] vs m [a], you can only go in one direction (via sequence :: Monad m => [m a] -> m [a]). Would you ever want to go in the opposite direction? Do you care about individual values having their own flags or would you rather annotate the computation as a whole with flags?
The real question is, what is your mental model for this? However, let's think about some consequences of each design choice.
If you choose to represent each value as Writer Any a and have all operations work with it, you can start with a newtype:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Control.Monad.Writer
newtype Value a = Value (Writer Any a)
deriving (Functor, Applicative, Monad)
Now you can define instances of standard type classes for your
values:
instance (Num a, Eq a) => Num (Value a) where
va + vb = do
a <- va
b <- vb
(Value . tell . Any) (b == 0 || a == 0)
return (a + b)
(*) = liftM2 (*)
abs = fmap abs
signum = fmap signum
negate = fmap negate
fromInteger = return . fromInteger
instance Monoid a => Monoid (Value a) where
mempty = pure mempty
mappend = liftM2 mappend
For an EDSL this gives a huge advantage: terseness and syntactic support from the compiler. You can now write getValue (42 + 0) instead of wbplus (pure 42) (pure 0).
If, instead, you don't think about flags as a part of your values and rather see them as an external effect, it's better to go with the alternative approach. But rather than write something like Writer Any [Int], use corresponding classes from mtl: MonadWriter Any m => m [Int].
This way, if you later find out that you need to use other effects, you can easily add them to some (but not all) operations. For example, you might want to raise an error in case of division by zero:
data DivisionByZero = DivisionByZero
divZ :: (MonadError DivisionByZero m, Fractional a, Eq a) => a -> a -> m a
divZ a b
| b == 0 = throwError DivisionByZero
| otherwise = pure (a / b)
plusF :: (MonadWriter Any m, Num a, Eq a) => a -> a -> m a
plusF a b = do
tell (Any (b == 0 || a == 0))
return (a + b)
Now you can use plusF and divZ together within one monad, although they have different effects. If you'll later find yourself in need to integrate with some external library, this flexibility will come in handy.
Now, I didn't give it too much thought, but perhaps you could combine those approaches using something like newtype Value m a = Value { getValue :: m a }. Good luck exploring the design space :)

Is there a Codensity MonadPlus that asymptotically optimizes a sequence of MonadPlus operations?

Recently there was a question about the relation between DList <-> [] versus Codensity <-> Free.
This made me think whether there is such a thing for MonadPlus. The Codensity monad improves the asymptotic performance only for the monadic operations, not for mplus.
Moreover, while there used to be Control.MonadPlus.Free, it has been removed in favor of FreeT f []. And since there is no explicit free MonadPlus, I'm not sure how one would express a corresponding improve variant. Perhaps something like
improvePlus :: Functor f => (forall m. (MonadFree f m, MonadPlus m) => m a) -> FreeT f [] a
?
Update: I attempted to create such a monad using the backtracking LogicT monad, which seems to be defined in a way similar to Codensity:
newtype LogicT r m a = LogicT { unLogicT :: forall r. (a -> m r -> m r) -> m r -> m r }
and is suited for backtracking computations, that is, MonadPlus.
Then I defined lowerLogic, similar to lowerCodensity as followd:
{-# LANGUAGE RankNTypes, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,
UndecidableInstances, DeriveFunctor #-}
import Control.Monad
import Control.Monad.Trans.Free
import Control.Monad.Logic
lowerLogic :: (MonadPlus m) => LogicT m a -> m a
lowerLogic k = runLogicT k (\x k -> mplus (return x) k) mzero
Then, after supplementing the corresponding MonadFree instance
instance (Functor f, MonadFree f m) => MonadFree f (LogicT m) where
wrap t = LogicT (\h z -> wrap (fmap (\p -> runLogicT p h z) t))
one can define
improvePlus :: (Functor f, MonadPlus mr)
=> (forall m. (MonadFree f m, MonadPlus m) => m a)
-> FreeT f mr a
improvePlus k = lowerLogic k
However, something isn't right with it, as it seems from my initial experiments that for some examples k is distinct from improvePlus k. I'm not sure, if this is a fundamental limitation of LogicT and a different, more complex monad is needed, or just if I defined lowerLogic (or something else) wrongly.
The following is all based on my (mis)understanding of this very
interesting paper posted by Matthew Pickering in his
comment: From monoids to near-semirings: the essence of MonadPlus and
Alternative (E. Rivas, M. Jaskelioff, T. Schrijvers). All results are theirs; all mistakes are mine.
From free monoids to DList
To build up the intuition, first consider the free monoid [] over
the category of Haskell types Hask. One problem with [] is that if
you have
(xs `mappend` ys) `mappend` zs = (xs ++ ys) ++ zs
then evaluating that requires traversing and re-traversing xs for
each left-nested application of mappend.
The solution is to use CPS in the form of difference
lists:
newtype DList a = DL { unDL :: [a] -> [a] }
The paper considers the generic form of this (called the Cayley
representation) where we're not tied to the free monoid:
newtype Cayley m = Cayley{ unCayley :: Endo m }
with conversions
toCayley :: (Monoid m) => m -> Cayley m
toCayley m = Cayley $ Endo $ \m' -> m `mappend` m'
fromCayley :: (Monoid m) => Cayley m -> m
fromCayley (Cayley k) = appEndo k mempty
Two directions of generalization
We can generalize the above construction in two ways: first, by
considering monoids not over Hask, but over endofunctors of Hask;
i.e.
monads; and second, by enriching the algebraic structure into
near-semirings.
Free monads to Codensity
For any Haskell (endo)functor f, we can construct the free
monad Free f, and
it will have the analogous performance problem with left-nested binds,
with the analogous solution of using the Cayley representation
Codensity.
Near-semirings instead of just monoids
This is where the paper stops reviewing concepts that are well-known
by the working Haskell programmer, and starts homing in on its goal. A
near-semiring is like a ring, except simpler, since both addition and
multiplication are just required to be monoids. The connection between
the two operations is what you expect:
zero |*| a = zero
(a |+| b) |*| c = (a |*| c) |+| (b |*| c)
where (zero, |+|) and (one, |*|) are the two monoids over some
shared base:
class NearSemiring a where
zero :: a
(|+|) :: a -> a -> a
one :: a
(|*|) :: a -> a -> a
The free near-semiring (over Hask) turns out to be the following
Forest type:
newtype Forest a = Forest [Tree a]
data Tree a = Leaf | Node a (Forest a)
instance NearSemiring (Forest a) where
zero = Forest []
one = Forest [Leaf]
(Forest xs) |+| (Forest ys) = Forest (xs ++ ys)
(Forest xs) |*| (Forest ys) = Forest (concatMap g xs)
where
g Leaf = ys
g (Node a n) = [Node a (n |*| (Forest ys))]
(good thing we don't have commutativity or inverses,
those make free representations far from
trivial...)
Then, the paper applies the Cayley representation twice, to the two
monoidal structures.
However, if we do this naively, we do
not get a good representation: we want to represent a near-semiring,
and therefore the whole near-semiring structure must be taken into
account and not just one chosen monoid structure. [...] [W]e obtain
the semiring of endomorphisms over endomorphisms DC(N):
newtype DC n = DC{ unDC :: Endo (Endo n) }
instance (Monoid n) => NearSemiring (DC n) where
f |*| g = DC $ unDC f `mappend` unDC g
one = DC mempty
f |+| g = DC $ Endo $ \h -> appEndo (unDC f) h `mappend` h
zero = DC $ Endo $ const mempty
(I've changed the implementation here slightly from the paper to
emphasize that we are using the Endo structure twice). When we'll
generalize this, the two layers will not be the same. The paper then
goes on to say:
Note that rep is not a near-semiring homomorphism from N into DC(N)
as it does not preserve the unit [...] Nevertheless, [...] the
semantics of a computation over a near-semiring will be preserved if
we lift values to the representation, do the near-semiring computation
there, and then go back to the original near-semiring.
MonadPlus is almost a near-semiring
The paper then goes on to reformulate the MonadPlus typeclass so
that it corresponds to the near-semiring rules: (mzero, mplus) is monoidal:
m `mplus` mzero = m
mzero `mplus` m = m
m1 `mplus` (m2 `mplus` m3) = (m1 `mplus` m2) `mplus` m3
and it interacts with the monad-monoid as expected:
join mzero = mzero
join (m1 `mplus` m2) = join m1 `mplus` join m2
Or, using binds:
mzero >>= _ = mzero
(m1 `mplus` m2) >>= k = (m1 >>= k) `mplus` (m2 >>= k)
However, these are not the rules of the existing MonadPlus
typeclass from
base,
which are listed as:
mzero >>= _ = mzero
_ >> mzero = mzero
The paper calls MonadPlus instances that satisfy the
near-semiring-like laws "nondeterminism monads", and
cites Maybe as an example that is a MonadPlus but not a
nondeterminism monad, since setting m1 = Just Nothing and m2 = Just
(Just False) is a counter-example to join (m1 `mplus` m2) = join m1
`mplus` join m2.
Free and Cayley representation of nondeterminism monads
Putting everything together, on one hand we have the Forest-like
free nondeterminism monad:
newtype FreeP f x = FreeP { unFreeP :: [FFreeP f x] }
data FFreeP f x = PureP x | ConP (f (FreeP f x))
instance (Functor f) => Functor (FreeP f) where
fmap f x = x >>= return . f
instance (Functor f) => Monad (FreeP f) where
return x = FreeP $ return $ PureP x
(FreeP xs) >>= f = FreeP (xs >>= g)
where
g (PureP x) = unFreeP (f x)
g (ConP x) = return $ ConP (fmap (>>= f) x)
instance (Functor f) => MonadPlus (FreeP f) where
mzero = FreeP mzero
FreeP xs `mplus` FreeP ys = FreeP (xs `mplus` ys)
and on the other, the double-Cayley representation of the two monoidal
layers:
newtype (:^=>) f g x = Ran{ unRan :: forall y. (x -> f y) -> g y }
newtype (:*=>) f g x = Exp{ unExp :: forall y. (x -> y) -> (f y -> g y) }
instance Functor (g :^=> h) where
fmap f m = Ran $ \k -> unRan m (k . f)
instance Functor (f :*=> g) where
fmap f m = Exp $ \k -> unExp m (k . f)
newtype DCM f x = DCM {unDCM :: ((f :*=> f) :^=> (f :*=> f)) x}
instance Monad (DCM f) where
return x = DCM $ Ran ($x)
DCM (Ran m) >>= f = DCM $ Ran $ \g -> m $ \a -> unRan (unDCM (f a)) g
instance MonadPlus (DCM f) where
mzero = DCM $ Ran $ \k -> Exp (const id)
mplus m n = DCM $ Ran $ \sk -> Exp $ \f fk -> unExp (a sk) f (unExp (b sk) f fk)
where
DCM (Ran a) = m
DCM (Ran b) = n
caylize :: (Monad m) => m a -> DCM m a
caylize x = DCM $ Ran $ \g -> Exp $ \h m -> x >>= \a -> unExp (g a) h m
-- I wish I called it DMC earlier...
runDCM :: (MonadPlus m) => DCM m a -> m a
runDCM m = unExp (f $ \x -> Exp $ \h m -> return (h x) `mplus` m) id mzero
where
DCM (Ran f) = m
The paper gives the following example of a computation running in a
nondeterminism monad that will behave poorly for FreeP:
anyOf :: (MonadPlus m) => [a] -> m a
anyOf [] = mzero
anyOf (x:xs) = anyOf xs `mplus` return x
Indeed, while
length $ unFreeP (anyOf [1..100000] :: FreeP Identity Int)
takes ages, the Cayley-transformed version
length $ unFreeP (runDCM $ anyOf [1..100000] :: FreeP Identity Int)
returns instantly.

Applicative Instance for (Monad m, Monoid o) => m o?

Sorry for the terrible title. I'm trying to make an instance of Applicative for a Monad wrapping a type that is a Monoid.
instance (Monad m, Monoid o) => Applicative (m o) where
pure x = return mempty
xm <*> ym = do
x <- xm
y <- ym
return $ x `mappend` y
This doesn't work; GCHi complains with:
Kind mis-match
The first argument of `Applicative' should have kind `* -> *',
but `m o' has kind `*'
In the instance declaration for `Applicative (m o)'
I realise that what I've written above may make no sense. Here is the context: I am trying to use the compos abstraction as described in the paper A pattern for almost compositional functions. Taking this tree (using the GADT version of compos; I've simplified it a lot):
data Tree :: * -> * where
Var :: String -> Expr
Abs :: [String] -> Expr -> Expr
App :: Expr -> [Expr] -> Expr
class Compos t where
compos :: Applicative f => (forall a. t a -> f (t a)) -> t c -> f (t c)
instance Compos Tree where
compos f t =
case t of
Abs ps e -> pure Abs <*> pure ps <*> f e
App e es -> pure App <*> f e <*> traverse f es
_ -> pure t
I'm going to write a lot of functions which descend the tree and return a list of say errors or a set of strings whilst also requiring state as it goes down (such as the binding environment), such as:
composFoldM :: (Compos t, Monad m, Monoid o) => (forall a. t a -> m o) -> t c -> m o
composFoldM f = ???
checkNames :: (Tree a) -> State (Set Name) [Error]
checkNames e =
case e of
Var n -> do
env <- get
-- check that n is in the current environment
return $ if Set.member n env then [] else [NameError n]
Abs ps e' -> do
env <- get
-- add the abstractions to the current environment
put $ insertManySet ps env
checkNames e'
_ -> composFoldM checkNames e
data Error = NameError Name
insertManySet xs s = Set.union s (Set.fromList xs)
I think these should all be able to be abstracted away by making composFoldM use compos for the (Monad m, Monoid o) => m o structure. So to use it with the GADT Applicative version of compos found on page 575/576 of the paper. I think I need to make an Applicative instance of this structure. How would I do this? Or am I going down completely the wrong path?
You want the Constant applicative from Data.Functor.Constant in the transformers package, which you can find here.
This Applicative has the following instance:
instance (Monoid a) => Applicative (Constant a) where
pure _ = Constant mempty
Constant x <*> Constant y = Constant (x `mappend` y)
You can then compose Constant with any other applicative using Compose from Data.Functor.Compose (also in the transformers package), which you can find here.
Compose has this Applicative instance:
instance (Applicative f, Applicative g) => Applicative (Compose f g) where
pure x = Compose (pure (pure x))
Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
You can then Compose your Constant applicative with any other Applicative (like State) to keep both some state and a running Monoid tally.
More generally, you should read the paper The Essence of the Iterator Pattern, which discusses these patterns in more detail.

How to map over Applicative form?

I want to map over Applicative form.
The type of map-like function would be like below:
mapX :: (Applicative f) => (f a -> f b) -> f [a] -> f [b]
used as:
result :: (Applicative f) => f [b]
result = mapX f xs
where f :: f a -> f b
f = ...
xs :: f[a]
xs = ...
As the background of this post, I try to write fluid simulation program using Applicative style referring to Paul Haduk's "The Haskell School of Expression", and I want to express the simulation with Applicative style as below:
x, v, a :: Sim VArray
x = x0 +: integral (v * dt)
v = v0 +: integral (a * dt)
a = (...calculate acceleration with x v...)
instance Applicative Sim where
...
where Sim type means the process of simulation computation and VArray means Array of Vector (x,y,z). X, v a are the arrays of position, velocity and acceleration, respectively.
Mapping over Applicative form comes when definining a.
I've found one answer to my question.
After all, my question is "How to lift high-order functions (like map
:: (a -> b) -> [a] -> [b]) to the Applicative world?" and the answer
I've found is "To build them using lifted first-order functions."
For example, the "mapX" is defined with lifted first-order functions
(headA, tailA, consA, nullA, condA) as below:
mapX :: (f a -> f b) -> f [a] -> f [b]
mapX f xs0 = condA (nullA xs0) (pure []) (consA (f x) (mapA f xs))
where
x = headA xs0
xs = tailA xs0
headA = liftA head
tailA = liftA tail
consA = liftA2 (:)
nullA = liftA null
condA b t e = liftA3 aux b t e
where aux b t e = if b then t else e
First, I don't think your proposed type signature makes much sense. Given an applicative list f [a] there's no general way to turn that into [f a] -- so there's no need for a function of type f a -> f b. For the sake of sanity, we'll reduce that function to a -> f b (to transform that into the other is trivial, but only if f is a monad).
So now we want:
mapX :: (Applicative f) => (a -> f b) -> f [a] -> f [b]
What immediately comes to mind now is traverse which is a generalization of mapM. Traverse, specialized to lists:
traverse :: (Applicative f) => (a -> f b) -> [a] -> f [b]
Close, but no cigar. Again, we can lift traverse to the required type signature, but this requires a monad constraint: mapX f xs = xs >>= traverse f.
If you don't mind the monad constraint, this is fine (and in fact you can do it more straightforwardly just with mapM). If you need to restrict yourself to applicative, then this should be enough to illustrate why you proposed signature isn't really possible.
Edit: based on further information, here's how I'd start to tackle the underlying problem.
-- your sketch
a = liftA sum $ mapX aux $ liftA2 neighbors (x!i) nbr
where aux :: f Int -> f Vector3
-- the type of "liftA2 neighbors (x!i) nbr" is "f [Int]
-- my interpretation
a = liftA2 aux x v
where
aux :: VArray -> VArray -> VArray
aux xi vi = ...
If you can't write aux like that -- as a pure function from the positions and velocities at one point in time to the accelerations, then you have bigger problems...
Here's an intuitive sketch as to why. The stream applicative functor takes a value and lifts it into a value over time -- a sequence or stream of values. If you have access to a value over time, you can derive properties of it. So velocity can be defined in terms of acceleration, position can be defined in terms of velocity, and soforth. Great! But now you want to define acceleration in terms of position and velocity. Also great! But you should not need, in this instance, to define acceleration in terms of velocity over time. Why, you may ask? Because velocity over time is all acceleration is to begin with. So if you define a in terms of dv, and v in terms of integral(a) then you've got a closed loop, and your equations are not propertly determined -- either there are, even given initial conditions, infinitely many solutions, or there are no solutions at all.
If I'm thinking about this right, you can't do this just with an applicative functor; you'll need a monad. If you have an Applicative—call it f—you have the following three functions available to you:
fmap :: (a -> b) -> f a -> f b
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
So, given some f :: f a -> f b, what can you do with it? Well, if you have some xs :: [a], then you can map it across: map (f . pure) xs :: [f b]. And if you instead have fxs :: f [a], then you could instead do fmap (map (f . pure)) fxs :: f [f b].1 However, you're stuck at this point. You want some function of type [f b] -> f [b], and possibly a function of type f (f b) -> f b; however, you can't define these on applicative functors (edit: actually, you can define the former; see the edit). Why? Well, if you look at fmap, pure, and <*>, you'll see that you have no way to get rid of (or rearrange) the f type constructor, so once you have [f a], you're stuck in that form.
Luckily, this is what monads are for: computations which can "change shape", so to speak. If you have a monad m, then in addition to the above, you get two extra methods (and return as a synonym for pure):
(>>=) :: m a -> (a -> m b) -> m b
join :: m (m a) -> m a
While join is only defined in Control.Monad, it's just as fundamental as >>=, and can sometimes be clearer to think about. Now we have the ability to define your [m b] -> m [b] function, or your m (m b) -> m b. The latter one is just join; and the former is sequence, from the Prelude. So, with monad m, you can define your mapX as
mapX :: Monad m => (m a -> m b) -> m [a] -> m [b]
mapX f mxs = mxs >>= sequence . map (f . return)
However, this would be an odd way to define it. There are a couple of other useful functions on monads in the prelude: mapM :: Monad m => (a -> m b) -> [a] -> m [b], which is equivalent to mapM f = sequence . map f; and (=<<) :: (a -> m b) -> m a -> m b, which is equivalent to flip (>>=). Using those, I'd probably define mapX as
mapX :: Monad m => (m a -> m b) -> m [a] -> m [b]
mapX f mxs = mapM (f . return) =<< mxs
Edit: Actually, my mistake: as John L kindly pointed out in a comment, Data.Traversable (which is a base package) supplies the function sequenceA :: (Applicative f, Traversable t) => t (f a) => f (t a); and since [] is an instance of Traversable, you can sequence an applicative functor. Nevertheless, your type signature still requires join or =<<, so you're still stuck. I would probably suggest rethinking your design; I think sclv probably has the right idea.
1: Or map (f . pure) <$> fxs, using the <$> synonym for fmap from Control.Applicative.
Here is a session in ghci where I define mapX the way you wanted it.
Prelude>
Prelude> import Control.Applicative
Prelude Control.Applicative> :t pure
pure :: Applicative f => a -> f a
Prelude Control.Applicative> :t (<*>)
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
Prelude Control.Applicative> let mapX fun ma = pure fun <*> ma
Prelude Control.Applicative> :t mapX
mapX :: Applicative f => (a -> b) -> f a -> f b
I must however add that fmap is better to use, since Functor is less expressive than Applicative (that means that using fmap will work more often).
Prelude> :t fmap
fmap :: Functor f => (a -> b) -> f a -> f b
edit:
Oh, you have some other signature for mapX, anyway, you maybe meant the one I suggested (fmap)?

Resources