Could this Haskell kata solution become more idiomatic?

Question

I retrain Haskell after a 10-year hiatus, partly to see what has changed, and partly as an antidote to days spent in C #, SQL, and JavaScript, and partly because of this, to suddenly cool down; -)

I decided to install the Hanoi Towers as an encoding kata, a fairly simple thing, but I already feel that my code is not idiomatic and would like to hear what kind of hints any old Haskell’s hands can have.

To make kata a little more interesting, I divided the problem into two parts: the first part, the moves function, generates a sequence of moves necessary to solve the puzzle. The rest of the code is for modeling towers and completing moves.

One part that I definitely feel unhappy with the moveDisc function would be tedious to spread over 4 towers.

Hanoi.hs

 module Hanoi where import Data.Maybe type Disc = Integer type Towers = [[Disc]] data Column = A | B | C deriving (Eq,Show) getDisc :: Towers -> Column -> Maybe Disc getDisc t A = listToMaybe $ t !! 0 getDisc t B = listToMaybe $ t !! 1 getDisc t C = listToMaybe $ t !! 2 validMove :: Towers -> Column -> Column -> Bool validMove tower from to | srcDisc == Nothing = False | destDisc == Nothing = True | otherwise = srcDisc < destDisc where srcDisc = getDisc tower from destDisc = getDisc tower to moveDisc :: Towers -> Column -> Column -> Towers moveDisc [a:as, b, c] AB = [as, a:b, c] moveDisc [a:as, b, c] AC = [as, b, a:c] moveDisc [a, b:bs, c] BA = [b:a, bs, c] moveDisc [a, b:bs, c] BC = [a, bs, b:c] moveDisc [a, b, c:cs] CA = [c:a, b, cs] moveDisc [a, b, c:cs] CB = [a, c:b, cs] moves :: Integer -> Column -> Column -> Column -> [(Column,Column)] moves 1 a _ c = [(a,c)] moves nabc = moves (n-1) acb ++ [(a,c)] ++ moves (n-1) bac solve :: Towers -> Towers solve towers = foldl (\t (from,to) -> moveDisc t from to) towers (moves len ABC) where len = height towers height :: Towers -> Integer height (t:_) = toInteger $ length t newGame :: Integer -> Towers newGame n = [[1..n],[],[]] 

TestHanoi.hs

 module TestHanoi where import Test.HUnit import Hanoi main = runTestTT $ "Hanoi Tests" ~: TestList [ getDisc [[1],[2],[2]] A ~?= Just 1 , getDisc [[1],[2],[3]] B ~?= Just 2 , getDisc [[1],[2],[3]] C ~?= Just 3 , getDisc [[],[2],[3]] A ~?= Nothing , getDisc [[1,2,3],[],[]] A ~?= Just 1 , validMove [[1,2,3],[],[]] AB ~?= True , validMove [[2,3],[1],[]] AB ~?= False , validMove [[3],[],[1,2]] AC ~?= False , validMove [[],[],[1,2,3]] AC ~?= False , moveDisc [[1],[],[]] AB ~?= [[],[1],[]] , moveDisc [[],[1],[]] BC ~?= [[],[],[1]] , moveDisc [[1,2],[],[]] AB ~?= [[2],[1],[]] , moveDisc [[],[2],[1]] CB ~?= [[],[1,2],[]] , moveDisc [[1,2],[],[]] AC ~?= [[2],[],[1]] , moveDisc [[3],[2],[1]] BA ~?= [[2,3],[],[1]] , moves 1 ABC ~?= [(A,C)] , moves 2 ABC ~?= [(A,B),(A,C),(B,C)] , "acceptance test" ~: solve [[1,2,3,4,5,6], [], []] ~?= [[],[],[1,2,3,4,5,6]] , "is optimal" ~: length (moves 3 ABC) ~?= 7 ] 

I look forward to hearing any comments or suggestions for improvement.

Answer 1

This is where implementation is done using an alternative view. Instead of storing three lists of sizing sizes, I save a list of columns where the first item corresponds to the position of the smallest disk, etc. This has the advantage that it is now impossible to imagine illegal conditions such as missing disks, large disks stacked on top of smaller ones, etc. It also makes many functions trivial to implement.

Hanoi.hs

 module Hanoi where import Control.Applicative import Control.Monad import Data.List import Data.Maybe type Disc = Integer type Towers = [Column] data Column = A | B | C deriving (Eq, Show) getDisc :: Column -> Towers -> Maybe Disc getDisc ct = (+1) . toInteger <$> elemIndex ct validMove :: Column -> Column -> Towers -> Bool validMove from to = isJust . moveDisc from to moveDisc :: Column -> Column -> Towers -> Maybe Towers moveDisc from to = foldr check Nothing . tails where check (c:cs) | c == from = const . Just $ to : cs | c == to = const Nothing | otherwise = fmap (c:) moves :: Integer -> Column -> Column -> Column -> [(Column,Column)] moves 1 a _ c = [(a,c)] moves nabc = moves (n-1) acb ++ [(a,c)] ++ moves (n-1) bac solve :: Towers -> Towers solve towers = fromJust $ foldM (\t (from,to) -> moveDisc from to t) towers (moves len ABC) where len = height towers height :: Towers -> Integer height = genericLength newGame :: Integer -> Towers newGame n = genericReplicate n A 

HanoiTest.hs

 module HanoiTest where import Test.HUnit import Hanoi main = runTestTT $ "Hanoi Tests" ~: TestList [ getDisc A [A, B, C] ~?= Just 1 , getDisc B [A, B, C] ~?= Just 2 , getDisc C [A, B, C] ~?= Just 3 , getDisc A [B, B, C] ~?= Nothing , getDisc A [A, A, A] ~?= Just 1 , validMove AB [A, A, A] ~?= True , validMove AB [B, A, A] ~?= False , validMove AC [C, C, A] ~?= False , validMove AC [C, C, C] ~?= False , moveDisc AB [A] ~?= Just [B] , moveDisc BC [B] ~?= Just [C] , moveDisc AB [A, A] ~?= Just [B, A] , moveDisc CB [C, B] ~?= Just [B, B] , moveDisc AC [A, A] ~?= Just [C, A] , moveDisc BA [C, B, A] ~?= Just [C, A, A] , moves 1 ABC ~?= [(A,C)] , moves 2 ABC ~?= [(A,B),(A,C),(B,C)] , "acceptance test" ~: solve [A, A, A, A, A, A] ~?= [C, C, C, C, C, C] , "is optimal" ~: length (moves 3 ABC) ~?= 7 ] 

Besides changing the view, I also made moveDisc total, returning it Nothing in case of an invalid move. That way, I could trivially implement validMove in terms of this. I really feel that there is a more elegant way to implement moveDisc .

Note that solve only works if the argument is the original position. This also applies to your code (it does not work due to incomplete patterns in moveDisc ). In this case, I return Nothing .

Edit: Added improved ramps to moveDisc and moveDisc arguments so that the last data structure is the last.

Answer 2

If you select Enum in a column, it is easy to rewrite moveDisk to accept arbitrary length lists.

Take the case (toInt a) < (toInt b) your new tower after the switch becomes the first (toInt a) - 1 your initial tower, and then the bottom of the second, and then the distance between a and b of the first, the head of the first minuses of the second , then the remainder.