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

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)