snippetMinor
How to avoid big tuple return types?
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
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:
The second change I would propose comes from the observation that you have two
Which leads to well-reading loop code:
And an outer loop that involves less plumbing:
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
Code can be found in my GitHub fork.
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
| LapDoneWhich 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
| LapDonemoveLoop [] 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.