module Homework.Ch01.Hanoi where import Data.Maybe -- | Move pegs from the first peg to the last peg. -- The moves that were made are returned, but an error is returned if a move -- can't be made. hanoi :: String -> String -> String -> Int -> Either String [Move] hanoi pegLabelA pegLabelB pegLabelC numDiscs = let -- CONSTRUCT a set of pegs given the provided arguments pegsStart = initPegs pegLabelA pegLabelB pegLabelC numDiscs -- Make a move (movesMade, _) = move pegsStart in -- Cheat the return for now, assume that movesMade is present for TDD Right [fromJust movesMade] -- | Make a move -- Given some pegs, make a move if a move is possible and return the pegs with -- the move that was made. -- -- The return of this function is a 2-tuple of ($THE_MOVE, $PEGS_AFTER_MOVE). move :: Pegs -> (Maybe Move, Pegs) move pegs = let -- pull apart the first peg pegA@(Peg firstPegLabel firstPegDiscs) = pegsPegA pegs -- pull apart the last peg pegC@(Peg lastPegLabel lastPegDiscs) = pegsPegC pegs -- get the smallest disc from the first peg firstPegDisc = last firstPegDiscs -- get the smallest disk from the last peg lastPegDisc = last lastPegDiscs -- the disc from the first peg can move to the last peg if it is smaller -- than the last peg's smallest disc canMove = firstPegDisc < lastPegDisc in -- return a tuple of (move made, pegs after move) if canMove then ( -- return the move made Just $ Move { moveFrom = firstPegLabel, moveTo = lastPegLabel }, -- modify the pegs to reflect the move pegs { -- Retain all discs but the last disc in peg A pegsPegA = pegA {pegDiscs = init firstPegDiscs}, -- Append peg A's last disk to the end of peg C's discs pegsPegC = pegC {pegDiscs = lastPegDiscs <> [firstPegDisc]} } ) else ( -- no move can be made, so no move is returned Nothing, -- return the pegs as they are pegs ) -- A set of pegs ordered from start to finish. data Pegs = Pegs {pegsPegA :: Peg, pegsPegB :: Peg, pegsPegC :: Peg} deriving (Eq, Show) -- CONSTRUCT a set of pegs with their labels and number of discs to fill the first peg with initPegs :: String -> String -> String -> Int -> Pegs initPegs pegLabelA pegLabelB pegLabelC numDiscs = Pegs { pegsPegA = fillPeg pegLabelA numDiscs, pegsPegB = emptyPeg pegLabelB, pegsPegC = emptyPeg pegLabelC } -- A peg is labeled and contains a stack of discs data Peg = Peg {pegLabel :: String, pegDiscs :: [Disc]} deriving (Eq, Show) -- CONSTRUCT a new peg with a label and number of disks to fill it with fillPeg :: String -> Int -> Peg fillPeg label numDiscs = Peg { pegLabel = label, pegDiscs = stackDiscs numDiscs } -- CONSTRUCT an empty peg with a label emptyPeg :: String -> Peg emptyPeg label = Peg {pegLabel = label, pegDiscs = []} -- A Disc has a size. data Disc = Disc {discSize :: Int} deriving (Eq, Ord, Show) -- CONSTRUCT a stack of discs stackDiscs :: Int -> [Disc] stackDiscs numDiscs = Disc <$> reverse [1 .. numDiscs] -- A move has the peg that the disc was moved from and the peg it was moved to data Move = Move {moveFrom :: String, moveTo :: String} deriving (Eq, Show)