[BUSTED] Feeling through the tower of hanoi problem

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.TowerOfHanoi
+      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.TowerOfHanoiSpec
       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/TowerOfHanoi.hs

@@ -0,0 +1,16 @@
+module Homework.Ch01.TowerOfHanoi where
+
+type Peg = String
+
+type Move = (Peg, Peg)
+
+hanoi :: Integer -> Peg -> Peg -> Peg -> [Move]
+hanoi n x y z = runHanoi [] (reverse $ initStack n) [] []
+  where
+    initStack 0 = []
+    initStack xx = xx : initStack (xx - 1)
+
+    runHanoi moves (itemX : stackX) [] [] = runHanoi ((x, z) : moves) stackX [] [itemX]
+    runHanoi moves (itemX : stackX) [] (itemZ : stackZ)
+      | itemX > itemZ = runHanoi ((x, y) : moves) stackX [itemX] (itemZ : stackZ)
+    runHanoi moves ()

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

@@ -50,7 +50,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/TowerOfHanoiSpec.hs

@@ -0,0 +1,13 @@
+module Homework.Ch01.TowerOfHanoiSpec where
+
+import Homework.Ch01.TowerOfHanoi
+import Test.Hspec
+
+spec :: Spec
+spec = describe "hanoi" $ do
+  it "explodes" $ do
+    hanoi 2 "a" "b" "c"
+      `shouldBe` [ ("a", "c"),
+                   ("a", "b"),
+                   ("c", "b")
+                 ]