Towers of Hanoi in Haskell, part I

hanoi-1.hs

type Disc = Int
type Tower = [Disc]
data Towers = Towers
            { towerA :: Tower
            , towerB :: Tower
            , towerC :: Tower
            } deriving (Show)

data TowerName = A | B | C
                 deriving (Show)

type Move = (TowerName, TowerName)

data TowerPointer = TowerPointer
                  { name :: TowerName
                  , pop  :: Towers -> (Disc, Towers)
                  , push :: Disc -> Towers -> Towers
                  }

ptrA = TowerPointer
     { name = A
     , pop  = \(Towers (d:a) b c) -> (d, Towers a b c)
     , push = \d (Towers a b c)   -> Towers (d:a) b c
     }

ptrB = TowerPointer
     { name = B
     , pop  = \(Towers a (d:b) c) -> (d, Towers a b c)
     , push = \d (Towers a b c)   -> Towers a (d:b) c
     }

ptrC = TowerPointer
     { name = C
     , pop  = \(Towers a b (d:c)) -> (d, Towers a b c)
     , push = \d (Towers a b c)   -> Towers a b (d:c)
     }

moveOne :: Towers -> TowerPointer -> TowerPointer
        -> ([Move], Towers)
moveOne towers src dst =
    let (disc, towers') = pop src towers
        towers''        = push dst disc towers'
        srcName         = name src
        dstName         = name dst
    in ([(srcName, dstName)], towers'')

moveMany :: Towers -> Int
         -> TowerPointer -> TowerPointer -> TowerPointer
         -> ([Move], Towers)
moveMany towers 1 src dst aux = moveOne towers src dst
moveMany towers n src dst aux =
    let (m1, towers')   = moveMany towers   (n-1) src aux dst
        (m2, towers'')  = moveMany towers'     1  src dst aux
        (m3, towers''') = moveMany towers'' (n-1) aux dst src
    in (m1++m2++m3, towers''')

towers = Towers [1, 2, 3, 4] [] []

solve :: Towers -> ([Move], Towers)
solve towers =
    let count = length $ towerA towers
    in  moveMany towers count ptrA ptrB ptrC

main = putStrLn $ show $ solve towers