Trying to implement "the essence of the iterator pattern" - haskell

Question

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?

Answer 1

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?

Answer 2

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"