Haskell Write Monad for expressions - haskell

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 :)

Related

How to write quickCheck on properties of functions?

I'm trying to do one of the Monoid exercises in Haskell Book (Chapter 15, "Monoid, Semigroup") but I'm stuck. The following is given:
newtype Combine a b =
Combine { unCombine :: (a -> b) }
and I'm supposed to write the Monoid instance for Combine.
I wrote something like this:
instance (Semigroup b) => Semigroup (Combine a b) where
Combine { unCombine = f } <> Combine { unCombine = g } =
Combine { unCombine = \x -> f x <> g x }
instance (Monoid b) => Monoid (Combine a b) where
mempty = Combine { unCombine = \_ -> mempty }
mappend = (<>)
but I do not know how to write the quickCheck for the instance.
Here is my try (does not compile):
monoidLeftIdentity1 :: (Eq m, Monoid m) => m -> Bool
monoidLeftIdentity1 x = mappend mempty x == x
monoidRightIdentity1 :: (Eq m, Monoid m) => m -> Bool
monoidRightIdentity1 x = mappend x mempty == x
main :: IO ()
main = do
quickCheck (monoidLeftIdentity1 :: Combine Int (Sum Int) -> Bool)
quickCheck (monoidRightIdentity1 :: Combine Int (Sum Int) -> Bool)
It seems I must instance Arbitrary and Eq on this type, but how to write them for a function?
There is a similar question, in that question, we are asked to write the Semigroup instance for Combine.
First a full code example:
module Main where
import Test.QuickCheck
import Data.Monoid
newtype Combine a b = Combine { unCombine :: a -> b }
instance (Semigroup b) => Semigroup (Combine a b) where
a <> _ = a
-- (Combine f) <> (Combine g) = Combine $ \a -> (f a) <> (g a)
instance (Monoid b) => Monoid (Combine a b) where
mempty = Combine $ \_ -> mempty
monoidLeftIdentity :: (Eq m, Monoid m) => m -> Bool
monoidLeftIdentity m = mappend mempty m == m
monoidRightIdentity :: (Eq m, Monoid m) => m -> Bool
monoidRightIdentity m = mappend m mempty == m
monoidLeftIdentityF :: (Eq b, Monoid m) => (Fun a b -> m) -> (m -> a -> b) -> a -> Fun a b -> Bool
monoidLeftIdentityF wrap eval point candidate = eval (mappend mempty m) point == eval m point
where m = wrap candidate
monoidRightIdentityF :: (Eq b, Monoid m) => (Fun a b -> m) -> (m -> a -> b) -> a -> Fun a b -> Bool
monoidRightIdentityF wrap eval point candidate = eval (mappend m mempty) point == eval m point
where m = wrap candidate
main :: IO ()
main = do
quickCheck $ (monoidLeftIdentityF (Combine . applyFun) unCombine :: Int -> Fun Int (Sum Int) -> Bool)
quickCheck $ (monoidRightIdentityF (Combine . applyFun) unCombine :: Int -> Fun Int (Sum Int) -> Bool)
What are we doing here?
First we need a way to generate random functions. That is, what this Fun thing is about. There is an Arbitrary instance for Fun a b, if there are certain instances available for a and b. But most of the time we have those.
A value of type Fun a b can be shown, so Fun a b has a show instance, provided a and b have one. We can extract the function with applyFun.
For QuickCheck to take advantage of this, we need to provide a Testable where all argument positions can be randomly generated and shown.
So we have to formulate our Properties in terms of a, b and Fun a b.
To connect all of this with Combine we provide a function from Fun a b to Combine a b.
Now we are stuck with another problem. We can't compare functions, so we can't compare values of type Combine a b for equality. As we are already randomly generating test cases, why not just generate the points, on which to test the functions for equality, also randomly. The equality will not be a sure thing, but we are hunting the falsifiable examples! So that is good enough for us. To do that, we provide a function to "apply" a value of type Combine a b to a value of type a, to get a value of type b, which can hopefully be compared for equality.
You can use Test.QuickCheck.Function to generate random function values, so you should be able to write something like the following to take care of the Arbitrary constraint:
quickCheck (monoidLeftIdentity1 . Combine . apply :: Fun Int (Sum Int) -> Bool)
For the Eq constraint, however, you will have trouble comparing function values. I think it should be enough to just check pointwise equality for some sampling of inputs, e.g.
funoidLeftIdentity1 :: (Monoid b, Eq b) => Fun a b -> a -> Bool
funoidLeftIdentity1 (Fn f) x = uncombine (Combine f <> mempty) x == uncombine mempty x

How to write a Traversable instance for function, in Haskell?

How do I write the Traversable instance for ((->) a)?
I think I could do it, if I could generically unwrap an Applicative Functor:
instance Traversable ((->) k) where
-- traverse :: (a -> f b) -> (k -> a) -> f (k -> b)
-- traverse h t = ?
-- h :: Applicative f => a -> f b
-- t :: k -> a
-- h . t :: k -> f b
-- unwrap . h . t :: k -> b
-- pure $ unwrap . h . t :: f (k -> b)
traverse h t = pure $ unwrap . h . t
unwrap :: (Functor f, Applicative f) => f a -> a
unwrap y#(pure x) = x
But, alas, GHC won't let me get away with that:
Parse error in pattern: pure
Generally there is no such thing as unwrap, consider f being the list functor [] what should unwrap return for [_, _, _] or better yet for the empty list []? Similar thing with Maybe, suppose h is const Nothing, you would expect to get Nothing. But your line of thought would fail upon trying to unwrap the Nothing into a value a. You can notice that trying to apply pure (to re-pack the result in the functor) means that you expect the result to be always Just for Maybe functor, non-empty for [] etc.
There is little hope for Traversable instance for a reader functor ((->) k). While it is not proof, a good evidence in that direction is that such an instance is missing from the Prelude. Also to traverse a function and produce a final container ([] or Maybe) you would need to apply your function h to any thinkable output of the function, that is a lot of potential values, in general infinitely many.
Prelude> traverse (\n -> if n == 42 then Nothing else Just n) [1, 2, 3]
Just [1,2,3]
Prelude> traverse (\n -> if n == 42 then Nothing else Just n) [1..]
Nothing
suppose that k is Int, so the functor is Int ->, suppose you have a value g :: Int -> Int, let it be \n -> if n == 42 then 0 else n, suppose you wanted to traverse that value with the above function, that traversal would be Nothing if g outputs 42 for any input, but it doesn't. The traversal cannot know that though (it has no access to the code of the function), so it would have to try all outputs.
If k were finite, then you could traverse a function by tabulating it. After traversing the table you could possibly produce a result. This may not be what you are after but:
import Data.Char
import Data.Maybe
import Data.Word
instance ( Enum k, Bounded k ) => Foldable ((->) k) where
foldMap h f = foldMap (h . f) domain
instance ( Enum k, Bounded k, Eq k ) => Traversable ((->) k) where
traverse h f = fmap (\vs k -> fromJust $ k `lookup` zip domain vs) (traverse (h . f) domain)
domain :: ( Enum k, Bounded k ) => [k]
domain = enumFromTo minBound maxBound
tabulate :: ( Enum k, Bounded k ) => (k -> a) -> [(k, a)]
tabulate f = zip domain (map f domain)
f1 :: Bool -> Int
f1 b = if b then 42 else 666
f2 :: Ordering -> Char
f2 LT = 'l'
f2 EQ = 'e'
f2 GT = 'g'
f3 :: Word8 -> Bool
f3 n = fromIntegral n < 256
f4 :: Word16 -> Bool
f4 n = fromIntegral n < 256
main = do
print (tabulate f1)
print (tabulate <$> traverse (\n -> [n, 2*n]) f1)
putStrLn ""
print (tabulate f2)
print (tabulate <$> traverse (\c -> [c, toUpper c]) f2)
putStrLn ""
print (tabulate f3)
print (tabulate <$> traverse (\b -> if b then Just b else Nothing) f3)
putStrLn ""
print (tabulate <$> traverse (\b -> if b then Just b else Nothing) f4)
But, alas, GHC won't let me get away with that:
It seems your error is that you tried to use a function (pure) as a pattern. Haskell only allows constructors to appear in patterns. So
unwrap (Just x) = x
is valid, while
unwrap (pure x) = x
is not.

Taking monadic functions out of a monad

Haskell has the function join, which "runs" a monadic action which is inside a monad:
join :: Monad m => m (m a) -> m a
join m = m >>= \f -> f
We can write a similar function for monadic functions with one argument:
join1 :: Monad m => m (a -> m b) -> (a -> m b)
join1 m arg1 = m >>= \f -> f arg1
And for two arguments:
join2 :: Monad m => m (a -> b -> m c) -> (a -> b -> m c)
join2 m arg1 arg2 = m >>= \f -> f arg1 arg2
Is it possible to write a general function joinN, that can handle monadic functions with N arguments?
You can do something like this with a fair amount of ugliness if you really desire.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
import Control.Monad (join, liftM)
class Joinable m z | z -> m where
joins :: m z -> z
instance Monad m => Joinable m (m a) where
joins = join
instance (Monad m, Joinable m z) => Joinable m (r -> z) where
joins m r = joins (liftM ($ r) m)
But, as you can see this relies on some shaky typeclass magic (in particular, the unenviable UndecidableInstances). It is quite possibly better—if ugly looking—to write all of the instances join1...join10 and export them directly. This is the pattern established in the base library as well.
Notably, inference won't work too well under this regime. For instance
λ> joins (return (\a b -> return (a + b))) 1 2
Overlapping instances for Joinable ((->) t0) (t0 -> t0 -> IO t0)
arising from a use of ‘joins’
Matching instances:
instance Monad m => Joinable m (m a)
-- Defined at /Users/tel/tmp/ASD.hs:11:10
instance (Monad m, Joinable m z) => Joinable m (r -> z)
-- Defined at /Users/tel/tmp/ASD.hs:14:10
but if we give an explicit type to our argument
λ> let {q :: IO (Int -> Int -> IO Int); q = return (\a b -> return (a + b))}
then it can still work as we hope
λ> joins q 1 2
3
This arises because with typeclasses alone it becomes quite difficult to indicate whether you want to operate on the monad m in the final return type of the function chain or the monad (->) r that is the function chain itself.
The short answer is no. The slightly longer answer is you could probably define an infix operator.
Take a look at the implementation for liftM: http://hackage.haskell.org/package/base-4.7.0.2/docs/src/Control-Monad.html#liftM
It defines up to liftM5. This is because it's not possible to define liftMN, just like your joinN isn't possible.
But we can take a lesson from Appicative <$> and <*> and define our own infix operator:
> let infixr 1 <~> ; x <~> f = fmap ($ x) f
> :t (<~>)
(<~>) :: Functor f => a -> f (a -> b) -> f b
> let foo x y = Just (x + y)
> let foobar = Just foo
> join $ 1 <~> 2 <~> foobar
Just 3
This is quite reminiscent of a common applicative pattern:
f <$> a1 <*> a2 .. <*> an
join $ a1 <~> a2 .. <~> an <~> f
A single function for every possible N? Not really. Generalizing over functions with different numbers of arguments like this is difficult in Haskell, in part because "number of arguments" is not always well-defined. The following are all valid specializations of id's type:
id :: a -> a
id :: (a -> a) -> a -> a
id :: (a -> a -> a) -> a -> a -> a
...
We'd need some way to get N at the type level, and then do a different thing depending on what N is.
Existing "variadic" functions like printf do this with typeclasses. They establish what N is by induction on ->: they have a "base case" instance for a non-function type like String and a recursive instance for functions:
instance PrintfType String ...
instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) ...
We can (after a lot of thinking :P) use the same approach here, with one caveat: our base case is a bit ugly. We want to start with the normal join, which produces a result of type m a; the problem is that to support any m a, we have to overlap with normal functions. This means that we need to enable a few scary extensions and that we might confuse the type inference system when we actually use our joinN. But, with the right type signatures in place, I believe it should work correctly.
First off, here's the helper class:
class Monad m => JoinN m ma where
joinN :: m ma -> ma
ma will take the relevant function type like a -> m b, a -> b -> m c and so on. I couldn't figure out how to leave m out of the class definition, so right off the bat we need to enable MultiParamTypeClasses.
Next, our base case, which is just normal join:
instance Monad m => JoinN m (m a) where
joinN = join
Finally, we have our recursive case. What we need to do is "peel off" an argument and then implement the function in terms of a smaller joinN. We do this with ap, which is <*> specialized to monads:
instance (Monad m, JoinN m ma) => JoinN m (b -> ma) where
joinN m arg = joinN (m `ap` return arg)
We can read the => in the instance as implication: if we know how to joinN an ma, we also know how to do a b -> ma.
This instance is slightly weird, so it requires FlexibleInstances to work. More troublingly, because our base case (m (m a)) is made up entirely of variables, it actually overlaps with a bunch of other reasonable types. To actually make this work we have to enable OverlappingInstances and IncoherentInstances, which are relatively tricky and bug-prone.
After a bit of cursory testing, it seems to work:
λ> let foo' = do getLine >>= \ x -> return $ \ a b c d -> putStrLn $ a ++ x ++ b ++ x ++ c ++ x ++ d
λ> let join4 m a b c d = m >>= \ f -> f a b c d
λ> join4 foo' "a" "b" "c" "d"
a b c d
λ> joinN foo' "a" "b" "c" "d"
a b c d

What are the steps for deducing this pointfree code?

I was reviewing some code and came across the following gem, which I'd wager is a copy-paste of pointfree output:
(I thought the following would more appropriate than the usual foo/bar for this particular question :P)
import Control.Monad (liftM2)
data Battleship = Battleship { x :: Int
, y :: Int
} deriving Show
placeBattleship :: Int -> Int -> Battleship
placeBattleship x' y' = Battleship { x = x', y = y' }
coordinates :: Battleship -> (Int, Int)
coordinates = liftM2 (,) x y
Would someone be kind enough to explain the steps needed to simplify from: (i) coordinates b = (x b, y b) to: (ii) coordinates = liftM2 (,) x y? In particular, I'm a bit confused as to the use of liftM2 as I wasn't even aware that a monad was lurking in the background.
I know that (i) can also be represented as: coordinates s = (,) (x s) (y s) but I'm not sure where/how to proceed.
P.S. The following is why I suspect it's from pointfree (output is from GHCI and :pl is aliased to pointfree):
λ: :pl coordinates s = (x s, y s)
coordinates = liftM2 (,) x y
This takes advantage of the Monad instance for (->) r, also called the "reader monad". This is the monad of functions from a specific type to a. (Take a look here for motivation on why it exists in the first place.)
To see how it works for various functions, replace m with (r -> in m a. For example, if we just do liftM, we get:
liftM :: (a -> b) -> (m a -> m b)
liftM :: (a -> b) -> ((r -> a) -> (r -> b))
:: (a -> b) -> (r -> a) -> (r -> b) -- simplify parentheses
...which is just function composition. Neat.
We can do the same thing for liftM2:
liftM2 :: (a -> b -> c) -> m a -> m b -> m c
liftM2 :: (a -> b -> c) -> (r -> a) -> (r -> b) -> (r -> c)
So what we see is a way to compose two one-argument functions with a two-argument function. It's a way of generalizing normal function composition to more than one argument. The idea is that we create a function that takes a single r by passing that through both of the one-argument functions, getting two arguments to pass into the two-argument function. So if we have f :: (r -> a), g :: (r -> b) and h :: (a -> b -> c), we produce:
\ r -> h (f r) (h r)
Now, how does this apply to your code? (,) is the two-argument function, and x and y are one-argument functions of the type Battleship -> Int (because that's how field accessors work). With this in mind:
liftM2 (,) x y = \ r -> (,) (x r) (y r)
= \ r -> (x r, y r)
Once you've internalized the idea of multiple function composition like this, point-free code like this becomes quite a bit more readable—no need to use the pointfree tool! In this case, I think the non-pointfree version is still better, but the pointfree one isn't terrible itself.
The monad liftM2 is working over here is the function monad (->) a. This is equivalent to the Reader monad, as you may have seen before.
Recall the definition of liftM2:
liftM2 :: Monad m => (a -> b -> r) -> m a -> m b -> m r
liftM2 f ma mb = do
a <- ma
b <- mb
return $ f a b
So now if we substitute in (,) for f, x for ma, and y for mb, we get
liftM2 (,) x y = do
a <- x
b <- y
return $ (,) a b
Since x, y :: Battleship -> Int which is equivalent to ((->) Battleship) Int, then m ~ (->) Battleship. The function monad is defined as
instance Monad ((->) a) where
return x = const x
m >>= f = \a -> f (m a) a
Essentially what the function monad does is allow you to extract the output from several functions provided they all have the same input. A more clear example might be something like
test = do
a <- (^2)
b <- (^3)
c <- (^4)
d <- show
return (a, b, c, d)
> test 2
(4, 8, 16, "2")
You could easily rewrite
data Battleship = Battleship { x :: Int
, y :: Int
} deriving Show
placeBattleship :: Int -> Int -> Battleship
placeBattleship x y = Battleship x y
coordinates :: Battleship -> (Int, Int)
coordinates (Battleship x y) = (x, y)
It isn't point-free style, but quite simple

Fusing traversals

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.

Resources