files/ch02/sample.log

@@ -1,11 +0,0 @@
-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,15 +23,12 @@ source-repository head
 library
   exposed-modules:
       Homework
-      Homework.Ch01.CreditCards
+      Homework.Ch01
-      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-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-deriving-strategies -Wmissing-home-modules -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-packages -Wunused-type-patterns
   build-depends:
       base >=4.14 && <5
   default-language: Haskell2010
@@ -42,7 +39,7 @@ executable homework
       Paths_homework
   hs-source-dirs:
       app
-  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
+  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
   build-depends:
       base >=4.14 && <5
     , homework
@@ -52,12 +49,11 @@ test-suite test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
-      Homework.Ch01.CreditCardsSpec
+      Homework.Ch01Spec
-      Homework.Ch01.HanoiSpec
       Paths_homework
   hs-source-dirs:
       test
-  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
+  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
   build-depends:
       base >=4.14 && <5
     , homework

lib/Homework/Ch01.hs

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

lib/Homework/Ch01/Hanoi.hs

@@ -1,114 +0,0 @@
-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

@@ -1,39 +0,0 @@
-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

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

package.yaml

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

test/Homework/Ch01/HanoiSpec.hs

@@ -1,105 +0,0 @@
-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]

test/Homework/Ch01Spec.hs

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