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 = []}