Complete chapter 14

14-testing/14.3-intermission.md

@@ -0,0 +1,2 @@
+# Intermission: Short Exercise
+see addition/Addition.hs

14-testing/14.7-chapter-exercises.md

@@ -0,0 +1,22 @@
+#  Chapter Excercises
+## Validating numbers into words
+see src/wordnumbertest.hs
+
+## Using QuickCheck
+see src/proptest.hs
+
+## Failure
+This will fill due to precision. `sqrt 2` cannot be accurately represented, so it is rounded to a ration number. This rounding error causes a different when squaring it.
+
+## Idempotence
+see src/idempotence.hs
+
+## Hangman testing
+see hangman/test/tests.hs
+
+## Validating ciphers
+No code available, but the principle is easy:
+1. Create generator for the input (limited to a-z and A-Z)
+2. Create generator for the caesar key (limited to 0-25)
+3. Create generator for vigenere key (limited to a-z)
+4. quickCheck the properties that decode after encode is the identity

14-testing/addition/Addition.hs

@@ -0,0 +1,108 @@
+-- Addition.hs
+module Addition where
+
+import Test.Hspec
+import Test.QuickCheck
+
+sayHello :: IO ()
+sayHello = putStrLn "hello"
+
+main :: IO ()
+main = hspec $ do
+    describe "Addition" $ do
+        it "1 + 1 is greater than 1" $ do
+            ((1 :: Integer) + 1) > 1 `shouldBe` True
+        it "2 + 2 is equal to 4" $ do
+            ((2 :: Integer) + 2) `shouldBe` 4
+        it "15 divided by 3 is 5" $ do
+            dividedBy (15 :: Integer) 3 `shouldBe` (5,0)
+        it "22 divided by 5 is 4 remainder 2" $ do
+            dividedBy (22 :: Integer) 5 `shouldBe` (4,2)
+        -- Intermission: Short Exercise
+        it "0 times 1 is 0" $ do
+            myMult (0 :: Integer) 1 `shouldBe` 0
+        it "1 times 0 is 0" $ do
+            myMult (1 :: Integer) 0 `shouldBe` 0
+        it "2 times 2 is 4" $ do
+            myMult (2 :: Integer) 2 `shouldBe` 4
+        it "2 times (-2) is (-4)" $ do
+            myMult (2 :: Integer) (-2) `shouldBe` (-4)
+        it "(-2) times 2 is (-4)" $ do
+            myMult (-2 :: Integer) 2 `shouldBe` (-4)
+        it "(-2) times (-2) is 4" $ do
+            myMult (-2 :: Integer) (-2) `shouldBe` 4
+        -- QuickCheck
+        it "x + 1 is always greater than x" $ do
+            property $ \x -> x + 1 > (x :: Int)
+
+
+dividedBy :: Integral a => a -> a -> (a,a)
+dividedBy num denom = go num denom 0
+    where go n d count
+            | n < d = (count, n)
+            | otherwise = go (n - d) d (count + 1)
+
+-- Intermission: Short Exercise
+myMult :: (Eq a, Num a) => a -> a -> a
+myMult 0 _ = 0
+myMult _ 0 = 0
+myMult a b = 
+    if abs b == b
+    then a + myMult a (b - 1)
+    else negate $ myMult a (negate b)
+
+trivialInt :: Gen Int
+trivialInt = return 1
+
+oneThroughThree :: Gen Int
+oneThroughThree = elements [1, 2, 3]
+
+oneThroughThree' :: Gen Int
+oneThroughThree' = elements [1, 2, 2, 2, 2, 2, 3]
+
+genBool :: Gen Bool
+genBool = choose (False, True)
+
+genBool' :: Gen Bool
+genBool' = elements [False, True]
+
+genOrdering :: Gen Ordering
+genOrdering = elements [LT, EQ, GT]
+
+genChar :: Gen Char
+genChar = elements ['a'..'z']
+
+genTuple :: (Arbitrary a, Arbitrary b) => Gen (a,b)
+genTuple = do
+    a <- arbitrary
+    b <- arbitrary
+    return (a,b)
+
+genThreeple :: (Arbitrary a, Arbitrary b, Arbitrary c) => Gen (a,b,c)
+genThreeple = do 
+    a <- arbitrary
+    b <- arbitrary
+    c <- arbitrary
+    return (a, b, c)
+
+genEither :: (Arbitrary a, Arbitrary b) => Gen (Either a b)
+genEither = do 
+    a <- arbitrary
+    b <- arbitrary
+    elements [Left a, Right b]
+
+genMaybe :: (Arbitrary a) => Gen (Maybe a)
+genMaybe = do 
+    a <- arbitrary
+    elements [Nothing, Just a]
+
+genMaybe' :: (Arbitrary a) => Gen (Maybe a)
+genMaybe' = do
+    a <- arbitrary
+    frequency [ (1, return Nothing), (3, return (Just a)) ]
+
+prop_additionGreater :: Int -> Bool
+prop_additionGreater x = x + 1 > x
+
+runQc :: IO ()
+runQc = quickCheck prop_additionGreater

14-testing/addition/addition.cabal

@@ -0,0 +1,18 @@
+-- addition.cabal
+name:           addition
+version:        0.1.0.0
+license-file:   LICENSE
+author:         Gaël Depreeuw
+maintainer:     sky@isfalling.org
+category:       Text
+build-type:     Simple
+cabal-version:  >=1.10
+
+library
+  exposed-modules:      Addition
+  ghc-options:          -Wall -fwarn-tabs
+  build-depends:        base >=4.7 && <5,
+                        hspec,
+                        QuickCheck
+  hs-source-dirs:       .
+  default-language:     Haskell2010

14-testing/addition/stack.yaml

@@ -0,0 +1,66 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+# resolver:
+#  name: custom-snapshot
+#  location: "./custom-snapshot.yaml"
+resolver: lts-9.10
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#   extra-dep: true
+#  subdirs:
+#  - auto-update
+#  - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.5"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

14-testing/hangman/LICENSE

@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2017
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

14-testing/hangman/README.md

@@ -0,0 +1 @@
+# hangman

14-testing/hangman/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

14-testing/hangman/app/Main.hs

@@ -0,0 +1,10 @@
+module Main where
+
+  import Hangman
+  import Data.Char (toLower)
+      
+  main :: IO ()
+  main = do
+    word <- randomWord'
+    let puzzle = freshPuzzle (fmap toLower word)
+    runGame puzzle

14-testing/hangman/hangman.cabal

@@ -0,0 +1,40 @@
+name:                hangman
+version:             0.1.0.0
+-- synopsis:
+-- description:
+homepage:            https://github.com/githubuser/hangman#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Gaël Depreeuw
+maintainer:          example@example.com
+copyright:           2017 Gaël Depreeuw
+category:            Game
+build-type:          Simple
+cabal-version:       >=1.10
+extra-source-files:  README.md,
+                     data/dict.txt
+
+library
+  exposed-modules:     Hangman
+  hs-source-dirs:      src
+  ghc-options:         -Wall -fwarn-tabs
+  build-depends:       base >= 4.7 && < 5
+                     , random
+                     , split
+  default-language:    Haskell2010
+
+executable hangman
+  hs-source-dirs:      app
+  main-is:             Main.hs
+  default-language:    Haskell2010
+  build-depends:       base >= 4.7 && < 5
+                     , hangman
+test-suite tests
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             tests.hs
+  build-depends:       base
+                     , hangman
+                     , hspec
+  ghc-options:         -Wall -fno-warn-orphans
+  default-language:    Haskell2010

14-testing/hangman/src/Hangman.hs

@@ -0,0 +1,118 @@
+module Hangman where
+    
+    import Control.Monad (forever)
+    import Data.Char (isAlpha)
+    import Data.Maybe (isJust)
+    import Data.List (intersperse)
+    import System.Exit (exitSuccess)
+    import System.Random (randomRIO)
+    
+    newtype WordList = WordList [String] deriving (Eq, Show)
+    
+    allWords :: IO WordList
+    allWords = do
+      dict <- readFile "data/dict.txt"
+      return (WordList $ lines dict)
+    
+    minWordLength :: Int
+    minWordLength = 5
+    
+    maxWordLength :: Int
+    maxWordLength = 9
+    
+    maxWrongGuesses :: Int
+    maxWrongGuesses = 10
+    
+    gameWords :: IO WordList
+    gameWords = do
+      WordList aw <- allWords
+      return $ WordList (filter gameLength aw)
+      where gameLength w = 
+              let l = length (w :: String)
+              in l >= minWordLength && l < maxWordLength
+                 && all isAlpha w
+    
+    randomWord :: WordList -> IO String
+    randomWord (WordList wl) = do
+      randomIndex <- randomRIO (0, length wl - 1)
+      return $ wl !! randomIndex
+    
+    randomWord' :: IO String
+    randomWord' = gameWords >>= randomWord
+    
+    data Puzzle = Puzzle String [Maybe Char] [Char] Int deriving (Eq)
+    instance Show Puzzle where
+      show (Puzzle _ discovered guessed i) =
+        (intersperse ' ' $ fmap renderPuzzleChar discovered)
+        ++ " Guessed so far: " ++ guessed ++ "\n"
+        ++ "Wrong guesses so far: " ++ show i
+        
+    freshPuzzle :: String -> Puzzle
+    freshPuzzle s = Puzzle s l [] 0
+        where l = fmap (const Nothing) s
+    
+    charInWord :: Puzzle -> Char -> Bool
+    charInWord (Puzzle s _ _ _) c = elem c s
+    
+    alreadyGuessed :: Puzzle -> Char -> Bool
+    alreadyGuessed (Puzzle _ _ s _) c = elem c s
+    
+    renderPuzzleChar :: Maybe Char -> Char
+    renderPuzzleChar Nothing = '_'
+    renderPuzzleChar (Just c) = c
+    
+    fillInCharacter :: Puzzle -> Char -> Puzzle
+    fillInCharacter (Puzzle word filledInSoFar s i) c =
+      Puzzle word newFilledInSoFar (c:s) i
+      where newFilledInSoFar = zipWith (zipper c) word filledInSoFar
+            zipper guessed wordChar guessChar =
+              if wordChar == guessed
+              then Just wordChar
+              else guessChar
+     
+    handleWrongGuess :: Puzzle -> Puzzle
+    handleWrongGuess (Puzzle w f g i) =
+      Puzzle w f g (i+1)
+    
+    handleGuess :: Puzzle -> Char -> IO Puzzle
+    handleGuess puzzle guess = do
+      putStrLn $ "Your guess was: " ++ [guess]
+      case (charInWord puzzle guess, alreadyGuessed puzzle guess) of
+        (_, True) -> do
+          putStrLn "You already guessed that character, pick something else!"
+          return puzzle
+        (True, _) -> do
+          putStrLn "This character was in the word, filling in the word\
+                   \ accordingly"
+          return (fillInCharacter puzzle guess)
+        (False, _) -> do
+          putStrLn "This character wasn't in the word, try again."
+          return $ handleWrongGuess (fillInCharacter puzzle guess)
+    
+    gameOver :: Puzzle -> Int -> IO ()
+    gameOver (Puzzle wordToGuess _ _ i) maxWrong =
+      if i >= maxWrong then
+        do putStrLn "You lose"
+           putStrLn $ "The word was: " ++ wordToGuess
+           exitSuccess
+      else return ()
+    
+    gameWin :: Puzzle -> IO ()
+    gameWin (Puzzle _ filledInSoFar _ _) =
+      if all isJust filledInSoFar then
+        do putStrLn "You win!"
+           exitSuccess
+      else return ()
+    
+    runGame :: Puzzle -> IO ()
+    runGame puzzle = forever $ do
+      gameOver puzzle maxWrongGuesses
+      gameWin puzzle
+      putStrLn $ "Current puzzle is: " ++ show puzzle
+      putStr "Guess a letter: "
+      guess <- getLine
+      case guess of
+        [c] -> handleGuess puzzle c >>= runGame
+        _   -> putStrLn "Your guess must be a single character"
+    
+    

14-testing/hangman/stack.yaml

@@ -0,0 +1,66 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+# resolver:
+#  name: custom-snapshot
+#  location: "./custom-snapshot.yaml"
+resolver: lts-9.10
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#   extra-dep: true
+#  subdirs:
+#  - auto-update
+#  - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.5"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

14-testing/hangman/test/tests.hs

@@ -0,0 +1,53 @@
+module Main where
+
+    import Hangman
+    import Test.Hspec        
+
+    testPuzzle :: Puzzle
+    testPuzzle = Puzzle "test" (take 4 $ repeat Nothing) "" 0
+    
+    correctChar :: Char
+    correctChar = 't'
+
+    guessCorrect :: Puzzle
+    guessCorrect = 
+        Puzzle "test" 
+               [Just correctChar, Nothing, Nothing, Just correctChar]
+               [correctChar]
+               0
+
+    wrongChar :: Char
+    wrongChar = 'a'
+
+    guessWrong :: Puzzle
+    guessWrong = 
+        Puzzle "test"
+               [Nothing, Nothing, Nothing, Nothing] 
+               [wrongChar] 
+               0
+    
+    test_fillInCharacter :: IO ()
+    test_fillInCharacter = hspec $ do
+        describe "fillInCharacter" $ do
+            it "Wrong guess only adds to guesses" $ do
+                fillInCharacter testPuzzle wrongChar 
+                == guessWrong
+            it "Right guess updates guesses and characters guessed so far" $ do
+                fillInCharacter testPuzzle correctChar
+                == guessCorrect
+
+    -- I feel like I don't grasp enough of the language yet
+    -- to propery do this. I can't compare IO Puzzle with Puzzle
+    -- and using <- to bind the Puzzle doesn't work yet.
+    -- test_handleGuess :: IO ()
+    -- test_handleGuess = hspec $ do
+    --     describe "handleGuess" $ do
+    --         it "Wrong guess only adds to guess" $ do
+    --             p <- handleGuess testPuzzle wrongChar
+    --             p == guessWrong
+                        
+    main :: IO ()
+    main = do
+        return ()
+        test_fillInCharacter
+        -- test_handleGuess

14-testing/morse/LICENSE

@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2017
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

14-testing/morse/README.md

@@ -0,0 +1 @@
+# morse

14-testing/morse/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

14-testing/morse/morse.cabal

@@ -0,0 +1,48 @@
+name:                morse
+version:             0.1.0.0
+-- synopsis:
+-- description:
+homepage:            https://github.com/githubuser/morse#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Gaël Depreeuw
+maintainer:          example@example.com
+copyright:           2017 Gaël Depreeuw
+category:            Web
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Morse
+  hs-source-dirs:      src
+  ghc-options:         -Wall -fwarn-tabs
+  build-depends:       base >= 4.7 && < 5
+                     , containers
+                     , QuickCheck
+  default-language:    Haskell2010
+
+executable morse
+  hs-source-dirs:      src
+  main-is:             Main.hs
+  ghc-options:         -Wall -fwarn-tabs
+  build-depends:       base >=4.7 && <5
+                     , morse
+                     , containers
+                     , QuickCheck
+  default-language:    Haskell2010
+
+test-suite tests
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             tests.hs
+  build-depends:       base
+                     , containers
+                     , morse
+                     , QuickCheck
+  ghc-options:         -Wall -fno-warn-orphans
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/githubuser/morse

14-testing/morse/src/Main.hs

@@ -0,0 +1,55 @@
+module Main where
+
+import Control.Monad (forever, when)
+import Data.List (intercalate)
+import Data.Traversable (traverse)
+import Morse (stringToMorse, morseToChar)
+import System.Environment (getArgs)
+import System.Exit (exitFailure, exitSuccess)
+import System.IO (hGetLine, hIsEOF, stdin)
+
+convertToMorse :: IO ()
+convertToMorse = forever $ do
+    weAreDone <- hIsEOF stdin
+    when weAreDone exitSuccess
+    -- otherwise, proceed.
+    line <- hGetLine stdin
+    convertLine line
+    where convertLine line = do
+            let morse = stringToMorse line
+            case morse of
+                (Just str) -> putStrLn (intercalate " " str)
+                Nothing    -> do
+                    putStrLn $ "ERROR: " ++ line
+                    exitFailure
+
+convertFromMorse :: IO ()
+convertFromMorse = forever $ do
+    weAreDone <- hIsEOF stdin
+    when weAreDone exitSuccess
+    -- otherwise, proceed.
+    line <- hGetLine stdin
+    convertLine line
+    where convertLine line = do
+            let decoded :: Maybe String
+                decoded = traverse morseToChar (words line)
+            case decoded of
+                (Just s) -> putStrLn s
+                Nothing  -> do
+                    putStrLn $ "Error: " ++ line
+                    exitFailure
+
+main :: IO ()
+main = do
+    mode <- getArgs
+    case mode of
+      [arg] ->
+        case arg of
+            "from" -> convertFromMorse
+            "to" -> convertToMorse
+            _    -> argError
+      _ -> argError
+    where argError = do
+            putStrLn "Please specify the first argument as being\
+                    \'from' or 'to' morse, such as: morse to"
+            exitFailure

14-testing/morse/src/Morse.hs

@@ -0,0 +1,65 @@
+module Morse
+    ( Morse
+    , charToMorse
+    , morseToChar
+    , stringToMorse
+    , letterToMorse
+    , morseToLetter
+    ) where
+
+import qualified Data.Map as M
+
+type Morse = String
+
+letterToMorse :: (M.Map Char Morse)
+letterToMorse = M.fromList [
+      ('a', ".-")
+    , ('b', "-...")
+    , ('c', "-.-.")
+    , ('d', "-..")
+    , ('e', ".")
+    , ('f', "..-.")
+    , ('g', "--.")
+    , ('h', "....")
+    , ('i', "..")
+    , ('j', ".---")
+    , ('k', "-.-")
+    , ('l', ".-..")
+    , ('m', "--")
+    , ('n', "-.")
+    , ('o', "---")
+    , ('p', ".--.")
+    , ('q', "--.-")
+    , ('r', ".-.")
+    , ('s', "...")
+    , ('t', "-")
+    , ('u', "..-")
+    , ('v', "...-")
+    , ('w', ".--")
+    , ('x', "-..-")
+    , ('y', "-.--")
+    , ('z', "--..")
+    , ('1', ".----")
+    , ('2', "..---")
+    , ('3', "...--")
+    , ('4', "....-")
+    , ('5', ".....")
+    , ('6', "-....")
+    , ('7', "--...")
+    , ('8', "---..")
+    , ('9', "----.")
+    , ('0', "-----")
+    ]
+
+morseToLetter :: M.Map Morse Char
+morseToLetter =
+    M.foldWithKey (flip M.insert) M.empty letterToMorse
+
+charToMorse :: Char -> Maybe Morse
+charToMorse c = M.lookup c letterToMorse
+
+stringToMorse :: String -> Maybe [Morse]
+stringToMorse = sequence . (fmap charToMorse)
+
+morseToChar :: Morse -> Maybe Char
+morseToChar m = M.lookup m morseToLetter

14-testing/morse/stack.yaml

@@ -0,0 +1,66 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+# resolver:
+#  name: custom-snapshot
+#  location: "./custom-snapshot.yaml"
+resolver: lts-9.10
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#   extra-dep: true
+#  subdirs:
+#  - auto-update
+#  - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.5"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

14-testing/morse/test/tests.hs

@@ -0,0 +1,26 @@
+module Main where
+
+import qualified Data.Map as M
+import Morse
+import Test.QuickCheck
+
+allowedChars :: [Char]
+allowedChars = M.keys letterToMorse
+
+allowedMorse :: [Morse]
+allowedMorse = M.elems letterToMorse
+
+charGen :: Gen Char
+charGen = elements allowedChars
+
+morseGen :: Gen Morse
+morseGen = elements allowedMorse
+
+prop_thereAndBackAgain :: Property
+prop_thereAndBackAgain =
+    forAll charGen
+    (\c -> ((charToMorse c)
+      >>= morseToChar ) == Just c)
+
+main :: IO ()
+main = quickCheck prop_thereAndBackAgain

14-testing/src/idempotence.hs

@@ -0,0 +1,31 @@
+module Idempotence where
+
+import Test.QuickCheck
+import Data.List (sort)
+import Data.Char (toUpper)
+
+twice :: (a -> a) -> a -> a
+twice f = f . f
+
+fourTimes :: (a -> a) -> a -> a
+fourTimes = twice . twice
+
+capitalizeWord :: String -> String
+capitalizeWord "" = ""
+capitalizeWord (x:xs) = (toUpper x) : xs
+
+-- 1
+prop_cap :: String -> Bool
+prop_cap s = (capitalizeWord s == twice capitalizeWord s) 
+             &&
+             (capitalizeWord s == fourTimes capitalizeWord s)
+-- 2
+prop_sort :: (Ord a, Eq a) => [a] -> Bool
+prop_sort xs = (sort xs == twice sort xs)
+               &&
+               (sort xs == fourTimes sort xs)
+
+main :: IO ()
+main = do
+    quickCheck prop_cap
+    quickCheck (prop_sort :: String -> Bool)

14-testing/src/makegen.hs

@@ -0,0 +1,14 @@
+module MakeGen where
+
+import Test.QuickCheck
+
+-- 1
+data Fool = Fulse | Frue deriving (Show, Eq)
+
+equal_foolGen :: Gen Fool
+equal_foolGen = elements [Fulse, Frue]
+
+-- 2
+skewed_foolGen :: Gen Fool
+skewed_foolGen = frequency [ (2, return Fulse), (1, return Frue) ]
+

14-testing/src/proptest.hs

@@ -0,0 +1,109 @@
+module PropTest where
+
+import Test.QuickCheck
+import Test.QuickCheck.Modifiers (NonZero)
+import Test.QuickCheck.Function 
+import Data.List (sort)
+
+-- Note:
+-- quickCheck takes a type of the Testable typeclass
+-- Arbitrary a => a -> Bool is an instance of this, since
+-- Bool is also Testable.
+
+-- 1
+half :: Fractional a => a -> a
+half = (/2)
+halfIdentity :: Fractional a => a -> a
+halfIdentity = (*2) . half
+
+prop_half :: (Eq a, Fractional a) => a -> Bool
+prop_half = \x -> halfIdentity x == x
+
+-- 2
+listOrdered :: (Ord a) => [a] -> Bool
+listOrdered xs =
+    snd $ foldr go (Nothing, True) xs
+    where go _ status@(_,False) = status
+          go y (Nothing, t) = (Just y, t)
+          go y (Just x, _) = (Just y, x >= y)
+prop_sort :: Ord a => [a] -> Bool
+prop_sort = listOrdered . sort
+
+-- 3
+plusAssociative :: (Num a, Eq a) => a -> a -> a -> Bool
+plusAssociative x y z = x + (y + z) == (x + y) + z
+plusCommutative :: (Num a, Eq a) => a -> a -> Bool
+plusCommutative x y = x + y == y + x
+
+-- 4
+multAssociative :: (Num a, Eq a) => a -> a -> a -> Bool
+multAssociative x y z = x * (y * z) == (x * y) * z
+multCommutative :: (Num a, Eq a) => a -> a -> Bool
+multCommutative x y = x * y == y * x
+
+-- 5
+prop_quotRem :: (Eq a, Integral a) => a -> a -> Bool
+prop_quotRem _ 0 = True -- exclude 0 from the test
+prop_quotRem x y = (quot x y)*y + (rem x y) == x
+prop_divMod :: (Eq a, Integral a) => a -> a -> Bool
+prop_divMod _ 0 = True -- exclude 0 from the test
+prop_divMod x y = (div x y)*y + (mod x y) == x
+-- other solution would be the create a generator for Int or Integers or ...
+-- which excludes 0
+-- OR use the modifiers from quickcheck
+prop_quotRem' :: (Eq a, Integral a) => NonZero a -> NonZero a -> Bool
+prop_quotRem' (NonZero x) (NonZero y) = (quot x y)*y + (rem x y) == x
+prop_divMod' :: (Eq a, Integral a) => NonZero a -> NonZero a -> Bool
+prop_divMod' (NonZero x) (NonZero y) = (div x y)*y + (mod x y) == x
+
+-- 6 These will fail
+prop_eAss :: (Eq a, Num a, Integral a) => a -> a -> a -> Bool
+prop_eAss x y z = x ^ (y ^ z) == (x ^ y) ^ z
+prop_eCom :: (Eq a, Num a, Integral a) => a -> a -> Bool
+prop_eCom x y = x ^ y == y ^ x
+
+-- 7
+prop_reverse :: Eq a => [a] -> Bool
+prop_reverse xs = (reverse . reverse) xs == id xs
+
+-- 8
+prop_apply :: Eq b => (Fun a b) -> a -> Bool
+prop_apply (Fun _ f) a = (f $ a) == f a
+prop_compose :: Eq c => (Fun b c) -> (Fun a b) -> a -> Bool
+prop_compose (Fun _ f) (Fun _ g) a = (f . g) a == f (g a)
+
+-- 9
+prop_append :: Eq a => [a] -> [a] -> Bool
+prop_append xs ys = foldr (:) xs ys == (++) xs ys
+prop_concat :: Eq a => [[a]] -> Bool
+prop_concat xs = foldr (++) [] xs == concat xs
+
+-- 10
+prop_length :: Int -> [a] -> Bool
+prop_length n xs = length (take n xs) == n
+
+-- 11
+prop_readshow :: (Read a, Show a, Eq a) => a -> Bool
+prop_readshow x = (read (show x)) == x
+
+main :: IO ()
+main = do
+    quickCheck (prop_half :: Double -> Bool) -- Float can also be checked
+    quickCheck (prop_sort :: [Int] -> Bool) -- Lots of other options available
+    quickCheck (plusAssociative :: Int -> Int -> Int -> Bool)
+    quickCheck (plusCommutative :: Integer -> Integer -> Bool)
+    quickCheck (multAssociative :: Int -> Int -> Int -> Bool)
+    quickCheck (multCommutative :: Integer -> Integer -> Bool)
+    quickCheck (prop_quotRem :: Integer -> Integer -> Bool)
+    quickCheck (prop_divMod :: Integer -> Integer -> Bool)
+    quickCheck (prop_quotRem' :: NonZero Integer -> NonZero Integer -> Bool)
+    quickCheck (prop_divMod' :: NonZero Integer -> NonZero Integer -> Bool)
+    quickCheck (prop_eAss :: Integer -> Integer -> Integer -> Bool) -- fails
+    quickCheck (prop_eCom :: Integer -> Integer -> Bool) -- fails
+    quickCheck (prop_reverse :: [Char] -> Bool)
+    quickCheck (prop_apply :: (Fun Integer Integer) -> Integer -> Bool)
+    quickCheck (prop_compose :: (Fun Int Int) -> (Fun Int Int) -> Int -> Bool)
+    quickCheck (prop_append :: [Char] -> [Char] -> Bool)
+    quickCheck (prop_concat :: [[Char]] -> Bool)
+    quickCheck (prop_length :: Int -> [String] -> Bool)
+    quickCheck (prop_readshow :: Int -> Bool)

14-testing/src/wordnumbertest.hs

@@ -0,0 +1,46 @@
+module WordNumberTest where
+
+import Test.Hspec
+import Data.List (intersperse)
+
+digitToWord :: Int -> String
+digitToWord 0 = "zero"
+digitToWord 1 = "one"
+digitToWord 2 = "two"
+digitToWord 3 = "three"
+digitToWord 4 = "four"
+digitToWord 5 = "five"
+digitToWord 6 = "six"
+digitToWord 7 = "seven"
+digitToWord 8 = "eight"
+digitToWord 9 = "nine"
+digitToWord _ = ""
+
+digits :: Int -> [Int]
+digits n
+    | d == 0 = [r]
+    | otherwise = digits d ++ [r]
+    where (d,r) = divMod (abs n) 10
+
+wordNumber :: Int -> String
+wordNumber = concat . intersperse "-" . map digitToWord . digits
+
+main :: IO ()
+main = hspec $ do
+    describe "digitToWord" $ do
+        it "return zero for 0" $ do
+            digitToWord 0 `shouldBe` "zero"
+        it "returns one for 1" $ do
+            digitToWord 1 `shouldBe` "one"
+        -- should test all numbers
+    describe "digits" $ do
+        it "returns [1] for 1" $ do
+            digits 1 `shouldBe` [1]
+        it "returns [1, 0, 0] for 100" $ do
+            digits 100 `shouldBe` [1,0,0]
+    describe "wordNumber" $ do
+        it "one-zero-zero given 100" $ do
+            wordNumber 100 `shouldBe` "one-zero-zero"
+        it "nine-zero-zero-one for 9001" $ do
+            wordNumber 9001 `shouldBe` "nine-zero-zero-one"
+