haskell-homework/lib/Homework/Ch01/Hanoi.hs

module Homework.Ch01.Hanoi where

newtype Peg = Peg ()

data Move = Move {moveFrom :: String, moveTo :: String} deriving (Eq, Show)

data Disc = Disc {discSize :: Int} deriving (Eq, Show, Ord)

type Pegs = [(String, [Disc])]

hanoi :: Int -> String -> String -> String -> Either String [Move]
hanoi numDisks pegLabelA pegLabelB pegLabelC =
  let pegs =
        [ (pegLabelA, fillPegWithDiscs numDisks),
          (pegLabelB, []),
          (pegLabelC, [])
        ]
   in Right $ snd $ move pegs

move :: Pegs -> (Pegs, [Move])
move pegs =
  let (firstPegLabel, firstPeg) = head pegs
      (lastPegLabel, lastPeg) = last pegs
      firstPegDisc = last firstPeg
      lastPegDisc = last lastPeg
      canMove = firstPegDisc < lastPegDisc
   in if canMove
        then
          ( [ (firstPegLabel, init firstPeg),
              head $ tail pegs,
              (lastPegLabel, lastPeg <> [firstPegDisc])
            ],
            [Move firstPegLabel lastPegLabel]
          )
        else (pegs, [])

fillPegWithDiscs :: Int -> [Disc]
fillPegWithDiscs numDisks = Disc <$> reverse [1 .. numDisks]