Noting regions in the code

files/ch02/sample.log

@@ -0,0 +1,11 @@
+I 6 Completed armadillo processing
+I 1 Nothing to report
+I 4 Everything normal
+I 11 Initiating self-destruct sequence
+E 70 3 Way too many pickles
+E 65 8 Bad pickle-flange interaction detected
+W 5 Flange is due for a check-up
+I 7 Out for lunch, back in two time steps
+E 20 2 Too many pickles
+I 9 Back from lunch
+E 99 10 Flange failed!

homework.cabal

@@ -23,12 +23,15 @@ source-repository head
 library
   exposed-modules:
       Homework
-      Homework.Ch01
+      Homework.Ch01.CreditCards
+      Homework.Ch01.Hanoi
+      Homework.Ch02.Log
+      Homework.Ch02.LogAnalysis
   other-modules:
       Paths_homework
   hs-source-dirs:
       lib
-  ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-packages -Wunused-type-patterns
+  ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-packages -Wunused-type-patterns
   build-depends:
       base >=4.14 && <5
   default-language: Haskell2010
@@ -39,7 +42,7 @@ executable homework
       Paths_homework
   hs-source-dirs:
       app
-  ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-packages -Wunused-type-patterns -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-packages -Wunused-type-patterns -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.14 && <5
     , homework
@@ -49,11 +52,12 @@ test-suite test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
-      Homework.Ch01Spec
+      Homework.Ch01.CreditCardsSpec
+      Homework.Ch01.HanoiSpec
       Paths_homework
   hs-source-dirs:
       test
-  ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-packages -Wunused-type-patterns -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-packages -Wunused-type-patterns -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.14 && <5
     , homework

lib/Homework/Ch01/CreditCards.hs

@@ -1,4 +1,4 @@
-module Homework.Ch01 where
+module Homework.Ch01.CreditCards where
 
 toDigits :: Integer -> [Integer]
 toDigits = go []

lib/Homework/Ch01/Hanoi.hs

@@ -0,0 +1,114 @@
+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]
+
+{------------------------------------------------------------------------------}
+{- MOVE -----------------------------------------------------------------------}
+{------------------------------------------------------------------------------}
+
+-- | 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
+          )
+
+{------------------------------------------------------------------------------}
+{- 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
+    }
+
+{------------------------------------------------------------------------------}
+{- PEG ------------------------------------------------------------------------}
+{------------------------------------------------------------------------------}
+
+-- 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 = []}
+
+{------------------------------------------------------------------------------}
+{- DISC -----------------------------------------------------------------------}
+{------------------------------------------------------------------------------}
+
+-- 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]
+
+{------------------------------------------------------------------------------}
+{- MOVE -----------------------------------------------------------------------}
+{------------------------------------------------------------------------------}
+
+-- 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)

lib/Homework/Ch02/Log.hs

@@ -0,0 +1,39 @@
+module Homework.Ch02.Log where
+
+data MessageType
+  = Info
+  | Warning
+  | Error Int
+  deriving (Show, Eq)
+
+type TimeStamp = Int
+
+data LogMessage
+  = LogMessage MessageType TimeStamp String
+  | Unknown String
+  deriving (Show, Eq)
+
+data MessageTree
+  = Leaf
+  | Node MessageTree LogMessage MessageTree
+  deriving (Show, Eq)
+
+-- | @testParse p n f@ tests the log file parser @p@ by running it
+--   on the first @n@ lines of file @f@.
+testParse ::
+  (String -> [LogMessage]) ->
+  Int ->
+  FilePath ->
+  IO [LogMessage]
+testParse parse n file = take n . parse <$> readFile file
+
+-- | @testWhatWentWrong p w f@ tests the log file parser @p@ and
+--   warning message extractor @w@ by running them on the log file
+--   @f@.
+testWhatWentWrong ::
+  (String -> [LogMessage]) ->
+  ([LogMessage] -> [String]) ->
+  FilePath ->
+  IO [String]
+testWhatWentWrong parse whatWentWrong file =
+  whatWentWrong . parse <$> readFile file

lib/Homework/Ch02/LogAnalysis.hs

@@ -0,0 +1,9 @@
+module Homework.Ch02.LogAnalysis where
+
+import Homework.Ch02.Log
+
+parse :: String -> [LogMessage]
+parse = fmap parseMessage . lines
+
+parseMessage :: String -> LogMessage
+parseMessage = undefined

package.yaml

@@ -16,7 +16,8 @@ dependencies:
 
 library:
   source-dirs: lib
-  dependencies: []
+  # dependencies:
+  # - unordered-containers
 
 executables:
   homework:
@@ -50,7 +51,6 @@ ghc-options:
   - -Wincomplete-patterns
   - -Wincomplete-record-updates
   - -Wincomplete-uni-patterns
-  - -Wmissing-deriving-strategies
   - -Wmissing-home-modules
   - -Wname-shadowing
   - -Wpartial-fields

test/Homework/Ch01/CreditCardsSpec.hs

@@ -1,6 +1,6 @@
-module Homework.Ch01Spec where
+module Homework.Ch01.CreditCardsSpec where
 
-import Homework.Ch01
+import Homework.Ch01.CreditCards
 import Test.Hspec
 
 spec :: Spec

test/Homework/Ch01/HanoiSpec.hs

@@ -0,0 +1,105 @@
+module Homework.Ch01.HanoiSpec where
+
+import Homework.Ch01.Hanoi
+import Test.Hspec
+
+spec :: Spec
+spec = describe "Hanoi" $ do
+  -- Testing the solver function
+  describe "hanoi" $ do
+    -- helper to construct a hanoi function with preconfigured labels
+    let hanoiOf = hanoi "a" "b" "c"
+
+    it "can solve for a stack of 1 disc" $ do
+      hanoiOf 1 --          a@[1] b@[] c@[]
+        `shouldBe` Right
+          [ Move "a" "c" -- a@[]  b@[] c@[1]
+          ]
+
+    it "can solve for a stack of 2 discs" $ do
+      hanoiOf 2 --           a@[2, 1] b@[]  c@[]
+        `shouldBe` Right
+          [ Move "a" "c", -- a@[2]    b@[]  c@[1]
+            Move "a" "b", -- a@[]     b@[2] c@[1]
+            Move "c" "a", -- a@[1]    b@[2] c@[]
+            Move "a" "c", -- a@[1]    b@[]  c@[2]
+            Move "a" "c" --  a@[]     b@[]  c@[2, 1]
+          ]
+
+    it "can solve for a stack of 3 discs" $ do
+      hanoiOf 3 --           a@[3, 2, 1] b@[]     c@[]
+        `shouldBe` Right
+          [ Move "a" "c", -- a@[3, 2]    b@[]     c@[1]
+            Move "a" "b", -- a@[3]       b@[2]    c@[1]
+            Move "c" "b", -- a@[3]       b@[2, 1] c@[]
+            Move "a" "c", -- a@[]        b@[2, 1] c@[3]
+            Move "b" "a", -- a@[1]       b@[2]    c@[3]
+            Move "b" "c", -- a@[1]       b@[]     c@[3, 2]
+            Move "a" "c" --  a@[]        b@[]     c@[3, 2, 1]
+          ]
+
+  {----------------------------------------------------------------------------}
+  {- MOVE ---------------------------------------------------------------------}
+  {----------------------------------------------------------------------------}
+
+  -- Testing individual moves
+  describe "move" $ do
+    it "moves the smallest peg from peg A to peg C if peg C's disc is bigger" $ do
+      let emptyPegs = initPegs "a" "b" "c" 0
+          pegs =
+            emptyPegs
+              { pegsPegA = (emptyPeg "a") {pegDiscs = [Disc 3, Disc 1]},
+                pegsPegC = (emptyPeg "c") {pegDiscs = [Disc 2]}
+              }
+          -- run the function
+          (moveMade, pegsAfterMove) = move pegs
+
+      -- a move should have been made
+      moveMade `shouldBe` Just (Move "a" "c")
+      -- the pegs should have changed
+      pegsAfterMove
+        `shouldBe` pegs
+          { pegsPegA = (pegsPegA pegs) {pegDiscs = [Disc 3]},
+            pegsPegC = (pegsPegC pegs) {pegDiscs = [Disc 2, Disc 1]}
+          }
+
+  {----------------------------------------------------------------------------}
+  {- PEGS ---------------------------------------------------------------------}
+  {----------------------------------------------------------------------------}
+
+  -- Testing constructor for a set of pegs
+  describe "initPegs" $ do
+    it "creates pegs with labels and fills the first peg with discs" $ do
+      initPegs "a" "b" "c" 3
+        `shouldBe` Pegs
+          { pegsPegA = Peg {pegLabel = "a", pegDiscs = [Disc 3, Disc 2, Disc 1]},
+            pegsPegB = Peg {pegLabel = "b", pegDiscs = []},
+            pegsPegC = Peg {pegLabel = "c", pegDiscs = []}
+          }
+
+  {----------------------------------------------------------------------------}
+  {- PEG ----------------------------------------------------------------------}
+  {----------------------------------------------------------------------------}
+
+  -- Testing constructor for a peg with discs
+  describe "fillPeg" $ do
+    it "creates a list of disks from biggest to smallest" $ do
+      fillPeg "a" 3
+        `shouldBe` Peg
+          { pegLabel = "a",
+            pegDiscs = [Disc 3, Disc 2, Disc 1]
+          }
+
+  -- Testing constructor for a peg without discs
+  describe "emptyPeg" $ do
+    it "creates an empty peg" $ do
+      emptyPeg "a"
+        `shouldBe` Peg
+          { pegLabel = "a",
+            pegDiscs = []
+          }
+
+  -- Testing constructor for a stack of discs
+  describe "stackDiscs" $ do
+    it "should create a stack of discs from largest to smallest" $ do
+      stackDiscs 3 `shouldBe` [Disc 3, Disc 2, Disc 1]