# How to avoid big tuple return types?

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.

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


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.