[Haskell-beginners] lifting to applicative: recomputing an argument each time it is used?

[Iain Nicol]

Hi,

I think I'm trying to lift 'Data.List.intersperse' (to applicative or a
monad) in such a way that its (first) argument is recomputed each time
it is used.  I'm hoping that there's a reusable, elegant or abstract,
approach for this that I'm unaware of.

If that isn't clear, I'm using QuickCheck to generate a "sentence" of a
random number of random words, each word separated by a random number of
spaces.  Importantly, there should be no connection between the number
of spaces separating the first and second word, and the number of spaces
separating the second and third word, etc.

I have code which works (run 'workingExample'), but it's not very
elegant---I ended up implementing the 'myIntersperse' function manually.
I had tried to write the code by fmap-ing Data.List.intersperse (see
'badExample'), but doing that naïvely has a major problem.  With that
approach, the number of spaces between each word is correctly random
between sentences, but is incorrectly constant within each generated
sentence.

If anybody knows a trick that I'm missing, that would be great.

Thanks.



{-# LANGUAGE ScopedTypeVariables #-}
import Control.Applicative
import Control.Monad
import Data.List (intersperse)
import Test.QuickCheck

-- | Generate a string consisting of one or more space character.
spaces :: Gen String
spaces = elements [" ", "      "]

-- Generate a (nonsensical) word.
word :: Gen String
word = elements ["foo", "bar", "baz", "bert"]

workingExample, badExample :: IO ()
workingExample = sample $ myIntersperse spaces (listOf word)
badExample = sample $ intersperse <$> spaces <*> listOf word

-- Like a lifted version of 'Data.List.intersperse'.  The interspersed
-- seperator is generated each time the separator appears, as opposed to
-- just once for the whole list.
myIntersperse :: Gen a -> Gen [a] -> Gen [a]
myIntersperse genSep genList = myIntersperse' genSep =<< genList
  where myIntersperse' :: forall a . Gen a -> [a] -> Gen [a]
        myIntersperse' genSep [] = return []
        myIntersperse' genSep xs = do
          let listElementWithSep :: Gen [(a, a)]
              listElementWithSep = zipWithM (\el sep -> pure (el, sep))
                                     xs
                                     =<< (sequence . repeat) genSep
          init <$> tupleListToList <$> listElementWithSep
        -- | Removes the tuple structure from a list, preserving the
        -- inner elements and their order.
        tupleListToList :: [(a, a)] -> [a]
        tupleListToList = concat . map (\(x, y) -> [x, y])


-- 
Iain