Compare commits
No commits in common. "ch01-hanoi-state-monad" and "main" have entirely different histories.
ch01-hanoi
...
main
5523
files/ch02/error.log
5523
files/ch02/error.log
File diff suppressed because it is too large
Load Diff
@ -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!
|
||||
@ -23,15 +23,12 @@ source-repository head
|
||||
library
|
||||
exposed-modules:
|
||||
Homework
|
||||
Homework.Ch01.CreditCards
|
||||
Homework.Ch01.Hanoi
|
||||
Homework.Ch02.Log
|
||||
Homework.Ch02.LogAnalysis
|
||||
Homework.Ch01
|
||||
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.Ch01.HanoiSpec
|
||||
Homework.Ch01Spec
|
||||
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
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
module Homework.Ch01.CreditCards where
|
||||
module Homework.Ch01 where
|
||||
|
||||
toDigits :: Integer -> [Integer]
|
||||
toDigits = go []
|
||||
@ -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)
|
||||
@ -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
|
||||
@ -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
|
||||
@ -16,8 +16,7 @@ dependencies:
|
||||
|
||||
library:
|
||||
source-dirs: lib
|
||||
# dependencies:
|
||||
# - unordered-containers
|
||||
dependencies: []
|
||||
|
||||
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
|
||||
|
||||
@ -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]
|
||||
@ -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
|
||||
Loading…
Reference in New Issue
Block a user