How to avoid big tuple return types?

Question

I recently got serious about learning Haskell and upon finishing chapter 4 in Real World Haskell, I decided to try out my accumulated knowledge on a project of my own.

This code hosted on github is a Kalaha solver. It's just one file of code and I've included information about the game and the rules in the README.

While I'm sure there are many problems with the code, the big code smell (from what I can tell) is the use of big tuples as return types. The biggest offender is this piece of code:

{-
 - Determines whether another lap is necessary.
 -}
moveMarbles :: (([Pot], Bool), Int, Bool) -> Int -> ([Pot], Bool)
moveMarbles ((listOfPots, landedInStore), marblesInHand, mustContinue) startingPot = resultingPotsAndStoreState where
    resultingPotsAndStoreState = lapLoop listOfPots landedInStore marblesInHand mustContinue startingPot

    lapLoop listOfPots landedInStoreLastLap marblesLeftFromLastLap mustContinue startingPot
        | not $ mustContinue = (listOfPots, landedInStoreLastLap)
        | otherwise = moveMarbles (moveOneLap listOfPots startingPot marblesLeftFromLastLap) 0

{-
 - Does the actual movement of marbles.
 - The top case in each of the loop sections only happens the first time the
 - loop is called (it's the only time no marbles are held).
 -}
moveOneLap :: [Pot] -> Int -> Int -> (([Pot], Bool), Int, Bool)
moveOneLap listOfPots startingPot startingMarblesInHand = ((modifiedPots, landedInStore), marblesLeftInHand, mustDoAnotherLap) where
    modifiedPots = untouchedFirstPots ++ moveLoop toTraverse startingMarblesInHand
    landedInStore = storeLoop toTraverse startingMarblesInHand
    marblesLeftInHand = marbleLoop toTraverse startingMarblesInHand
    mustDoAnotherLap = continuationLoop toTraverse startingMarblesInHand
    untouchedFirstPots = take (startingPot - 1) listOfPots
    toTraverse = drop (startingPot - 1) listOfPots

    moveLoop [] _ = []
    moveLoop (x:xs) marblesInHand
        | marblesInHand == 0 = returnEmptyPot x : moveLoop xs (marbleCount x)
        | marblesInHand > 1 = returnPotWithOneMoreMarble x : moveLoop xs (marblesInHand - 1)
        | isStore x && marblesInHand == 1 = returnPotWithOneMoreMarble x : xs
        | (not $ isPotEmpty x) && marblesInHand == 1 = returnEmptyPot x : moveLoop xs (marbleCount x + 1)
        | isPotEmpty x && marblesInHand == 1 = returnPotWithOneMoreMarble x : xs
        where
            returnPotWithOneMoreMarble pot = pot { marbleCount = (marbleCount pot + 1) }
            returnEmptyPot pot = pot { marbleCount = 0 }

    marbleLoop [] marblesInHand = marblesInHand
    marbleLoop (x:xs) marblesInHand
        | marblesInHand == 0 = marbleLoop xs (marbleCount x)
        | marblesInHand > 1 = marbleLoop xs (marblesInHand - 1)
        | isStore x && marblesInHand == 1 = 0
        | (not $ isPotEmpty x) && marblesInHand == 1 = marbleLoop xs (marbleCount x + 1)
        | isPotEmpty x && marblesInHand == 1 = 0

    continuationLoop [] _ = True
    continuationLoop (x:xs) marblesInHand
        | marblesInHand == 0 = continuationLoop xs (marbleCount x)
        | marblesInHand > 1 = continuationLoop xs (marblesInHand - 1)
        | isStore x && marblesInHand == 1 = False
        | (not $ isPotEmpty x) && marblesInHand == 1 = continuationLoop xs (marbleCount x + 1)
        | isPotEmpty x && marblesInHand == 1 = False

    storeLoop [] _ = False
    storeLoop (x:xs) marblesInHand
        | marblesInHand == 0 = storeLoop xs (marbleCount x)
        | marblesInHand > 1 = storeLoop xs (marblesInHand - 1)
        | isStore x && marblesInHand == 1 = True
        | (not $ isPotEmpty x) && marblesInHand == 1 = storeLoop xs (marbleCount x + 1)
        | isPotEmpty x && marblesInHand == 1 = False

The way I see it, a player makes a lap around the board, and then for the next lap a lot of information needs to be passed on (should he do another lap, what was the state of the board from the last lap...), which both results in a huge return type and multiple loops doing pretty much the same thing but with different results.

I guess that this could all be avoided if I had a more clever approach to the problem, but as mentioned, I'm no more than a beginner.

Answer 1

I would suggest two refactorings:

First note that you can indeed simply merge the four loops by giving them tuple results. After a few smaller changes I arrived at the following code:

moveOneLap :: [Pot] -> Int -> Int -> (([Pot], Bool), Int, Bool)
moveOneLap listOfPots startingPot startingMarblesInHand = ((modifiedPots, landedInStore), marblesLeftInHand, mustDoAnotherLap)
  where
    (untouchedFirstPots, toTraverse)
      = splitAt (startingPot - 1) listOfPots
    (newPots, marblesLeftInHand, mustDoAnotherLap, landedInStore)
      = moveLoop toTraverse startingMarblesInHand []
    modifiedPots
      = untouchedFirstPots ++ newPots

    moveLoop []     marblesInHand xs' = ([],           marblesInHand, True, False)
    moveLoop (x:xs) marblesInHand xs'
        | marblesInHand == 0          = moveLoop xs (marbleCount x)     (emptyPot  : xs')
        | marblesInHand >  1          = moveLoop xs (marblesInHand - 1) (addMarble : xs')
        | marblesInHand /= 1          = error "strange - marblesInHand was negative?"
        | isStore x                   = (finishedPots, 0,             False, True)
        | isPotEmpty x                = (finishedPots, 0,             False, False)
        | otherwise                   = moveLoop xs (marbleCount x + 1) (emptyPot  : xs')
        where
          addMarble    = x { marbleCount = (marbleCount x + 1) }
          emptyPot     = x { marbleCount = 0 }
          finishedPots = reverse (addMarble : xs)

The second change I would propose comes from the observation that you have two Bool getting passed back - as well as a number that is in two cases always zero! We could easily translate that into an algebraic data type:

data LapResult = LapContinue Int
               | LapLandedInStore
               | LapDone

Which leads to well-reading loop code:

moveLoop []     marblesInHand xs' = ([],           LapContinue marblesInHand)
moveLoop (x:xs) marblesInHand xs'
    ....
    | isStore x                   = (finishedPots, LapLandedInStore)
    | isPotEmpty x                = (finishedPots, LapDone)

And an outer loop that involves less plumbing:

moveMarbles :: [Pot] -> Int -> Int -> ([Pot], Bool)
moveMarbles listOfPots startingPot marblesInHand =
  let (newPots, lapResult) = moveOneLap listOfPots startingPot marblesInHand in
  case lapResult of
    LapContinue newMarblesInHand -> moveMarbles newPots 0 newMarblesInHand
    LapLandedInStore             -> (newPots, True)
    LapDone                      -> (newPots, False)

I didn't test this, so apologies if I introduced a bug at some point. But this is the direction I would go into style-wise.

Final note: Generally, when you find yourself passing in and out big tuples of things, it is often worthwhile to starting looking out whether a State or Reader monad might improve things. For example, you could have a State monad tracking your current pots. However, the rest of your code doesn't look like it would benefit from this transformation, so I left it like this.

Code can be found in my GitHub fork.