Можно ли сделать это ката-решение Haskell более идиоматичным?

Вот реализация, использующая альтернативное представление. Вместо хранения трех списков размеров привязок я храню список столбцов, где первый элемент соответствует положению наименьшего диска, и так далее. Преимущество этого заключается в том, что теперь невозможно представить недопустимые состояния, такие как отсутствующие диски, большие диски, расположенные поверх меньших, и т. д. Это также делает реализацию многих функций тривиальной.

Ханой.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 c t = (+1) . toInteger <$> elemIndex c t

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 n a b c = moves (n-1) a c b ++ [(a,c)] ++ moves (n-1) b a c

solve :: Towers -> Towers
solve towers = fromJust $ foldM (\t (from,to) -> moveDisc from to t) towers (moves len A B C)
    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 A B [A, A, A] ~?= True ,
    validMove A B [B, A, A] ~?= False ,
    validMove A C [C, C, A] ~?= False ,
    validMove A C [C, C, C] ~?= False ,

    moveDisc A B [A] ~?= Just [B] ,
    moveDisc B C [B] ~?= Just [C] ,
    moveDisc A B [A, A] ~?= Just [B, A] ,
    moveDisc C B [C, B] ~?= Just [B, B] ,
    moveDisc A C [A, A] ~?= Just [C, A] ,
    moveDisc B A [C, B, A] ~?= Just [C, A, A] ,

    moves 1 A B C ~?= [(A,C)] ,
    moves 2 A B C ~?= [(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 A B C) ~?= 7
    ]

Помимо изменения представления, я также сделал общее количество moveDisc, заставив его вернуть Nothing в случае недопустимого хода. Таким образом, я мог тривиально реализовать validMove с его точки зрения. Я чувствую, что есть более элегантный способ реализовать moveDisc.

Обратите внимание, что solve работает только в том случае, если аргумент является начальной позицией. Это также относится и к вашему коду (он не работает из-за неполных шаблонов в moveDisc). Я возвращаю Nothing в этом случае.

Изменить: добавлен улучшенный moveDisc Рэмпиона и изменен порядок аргументов, чтобы структура данных была последней.

Если вы выведете Enum из столбца, то легко переписать moveDisk для получения списков произвольной длины.

Возьмем случай (toInt a) < (toInt b) вашей новой башни после того, как переключатель - это первая (toInt a) - 1 вашей исходной башни, затем нижняя часть второй, затем расстояние между a и b первой, голова первой против второй, затем остаток.