HiveBrain v1.2.0
Get Started
← Back to all entries
snippetMinor

How to avoid big tuple return types?

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
typesreturnavoidtuplebighow

Problem

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 x

Solution

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.

Code Snippets

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)
data LapResult = LapContinue Int
               | LapLandedInStore
               | LapDone
moveLoop []     marblesInHand xs' = ([],           LapContinue marblesInHand)
moveLoop (x:xs) marblesInHand xs'
    ....
    | isStore x                   = (finishedPots, LapLandedInStore)
    | isPotEmpty x                = (finishedPots, LapDone)
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)

Context

StackExchange Code Review Q#13189, answer score: 4

Revisions (0)

No revisions yet.