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

module Homework.Ch01.Hanoi where

import Data.Maybe

data Peg = Peg {pegLabel :: String, pegDiscs :: [Disc]} deriving (Eq, Show)

data Pegs = Pegs {pegsPegA :: Peg, pegsPegB :: Peg, pegsPegC :: Peg} deriving (Eq, Show)

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

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

hanoi :: Int -> String -> String -> String -> Either String [Move]
hanoi numDiscs pegLabelA pegLabelB pegLabelC =
  let pegs =
        Pegs
          { pegsPegA = fillPeg pegLabelA numDiscs,
            pegsPegB = emptyPeg pegLabelB,
            pegsPegC = emptyPeg pegLabelC
          }
   in Right . return . fromJust . fst $ move pegs

move :: Pegs -> (Maybe Move, Pegs)
move pegs =
  let pegA@(Peg firstPegLabel firstPegDiscs) = pegsPegA pegs
      pegC@(Peg lastPegLabel lastPegDiscs) = pegsPegC pegs
      firstPegDisc = last firstPegDiscs
      lastPegDisc = last lastPegDiscs
      canMove = firstPegDisc < lastPegDisc
   in if canMove
        then
          ( Just $ Move firstPegLabel lastPegLabel,
            pegs
              { pegsPegA = pegA {pegDiscs = init firstPegDiscs},
                pegsPegC = pegC {pegDiscs = lastPegDiscs <> [firstPegDisc]}
              }
          )
        else (Nothing, pegs)

fillPeg :: String -> Int -> Peg
fillPeg label numDisks =
  Peg
    { pegLabel = label,
      pegDiscs = Disc <$> reverse [1 .. numDisks]
    }

emptyPeg :: String -> Peg
emptyPeg label = Peg {pegLabel = label, pegDiscs = []}