Skip to content

Commit 45ced5e

Browse files
dwaynedwayne
committed
Update the Addition module from ch14
1 parent b3c33b2 commit 45ced5e

File tree

5 files changed

+158
-105
lines changed

5 files changed

+158
-105
lines changed

‎ch14/addition/Addition.hs

Lines changed: 133 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -1,33 +1,138 @@
11
module Addition where
22

33
import Test.Hspec
4+
import Test.QuickCheck
5+
6+
7+
trivialInt :: Gen Int
8+
trivialInt = return 1
9+
10+
11+
oneThroughThree :: Gen Int
12+
oneThroughThree =
13+
-- elements [1, 2, 3] -- each Int has the same probability of showing up
14+
-- here the probabilities are:
15+
-- 1: 1/6
16+
-- 2: 4/6 = 2/3
17+
-- 3: 1/6
18+
elements [1, 2, 2, 2, 2, 3]
19+
20+
21+
genBool :: Gen Bool
22+
genBool = choose (False, True)
23+
24+
25+
genBool' :: Gen Bool
26+
genBool' = elements [False, True]
27+
28+
29+
genOrdering :: Gen Ordering
30+
genOrdering = elements [LT, EQ, GT]
31+
32+
33+
genChar :: Gen Char
34+
genChar = elements ['a'..'z']
35+
36+
37+
genTuple :: (Arbitrary a, Arbitrary b) => Gen (a, b)
38+
genTuple = do
39+
a <- arbitrary
40+
b <- arbitrary
41+
return (a, b)
42+
43+
44+
genThreeple :: (Arbitrary a, Arbitrary b, Arbitrary c) => Gen (a, b, c)
45+
genThreeple = do
46+
a <- arbitrary
47+
b <- arbitrary
48+
c <- arbitrary
49+
return (a, b, c)
50+
51+
52+
genEither :: (Arbitrary a, Arbitrary b) => Gen (Either a b)
53+
genEither = do
54+
a <- arbitrary
55+
b <- arbitrary
56+
elements [Left a, Right b]
57+
58+
59+
-- equal probability
60+
genMaybe :: Arbitrary a => Gen (Maybe a)
61+
genMaybe = do
62+
a <- arbitrary
63+
elements [Nothing, Just a]
64+
65+
66+
-- What QuickCheck actually does
67+
-- so you get more Just values
68+
genMaybe' :: Arbitrary a => Gen (Maybe a)
69+
genMaybe' = do
70+
a <- arbitrary
71+
frequency [ (1, return Nothing)
72+
, (3, return (Just a))
73+
]
74+
-- frequency :: [(Int, Gen a)] -> Gen a
75+
76+
77+
prop_additionGreater :: Int -> Bool
78+
prop_additionGreater x = x + 1 > x
79+
-- = x + 0 > x -- asserting something untrue
80+
81+
82+
runQc :: IO ()
83+
runQc = quickCheck prop_additionGreater
84+
85+
86+
main :: IO ()
87+
main = hspec $ do
88+
describe "Addition" $ do
89+
it "1 + 1 is greater than 1" $ do
90+
(1 + 1) > 1 `shouldBe` True
91+
it "2 + 2 is equal to 4" $ do
92+
2 + 2 `shouldBe` 4
93+
94+
it "x + 1 is always greater than x" $ do
95+
property $ \x -> x + 1 > (x :: Int)
96+
97+
describe "Division" $ do
98+
it "15 dividedBy 3 is 5" $ do
99+
dividedBy 15 3 `shouldBe` (5, 0)
100+
it "22 dividedBy 5 is 4 remainder 2" $ do
101+
dividedBy 22 5 `shouldBe` (4, 2)
102+
103+
-- Intermission: Short Exercise
104+
-- see myMult
105+
describe "Multiplication" $ do
106+
it "6 * 3 is 18" $ do
107+
myMult 6 3 `shouldBe` 18
108+
it "3 * 6 is 18" $ do
109+
myMult 3 6 `shouldBe` 18
110+
it "6 * 0 is 0" $ do
111+
myMult 6 0 `shouldBe` 0
112+
it "0 * 6 is 0" $ do
113+
myMult 0 6 `shouldBe` 0
114+
it "6 * -3 is -18" $ do
115+
myMult 6 (-3) `shouldBe` (-18)
116+
it "-3 * 6 is -18" $ do
117+
myMult (-3) 6 `shouldBe` (-18)
118+
it "-6 * -3 is 18" $ do
119+
myMult (-6) (-3) `shouldBe` 18
120+
it "-3 * -6 is 18" $ do
121+
myMult (-3) (-6) `shouldBe` 18
122+
123+
124+
sayHello :: IO ()
125+
sayHello = putStrLn "hello!"
126+
127+
128+
dividedBy :: Integral a => a -> a -> (a, a)
129+
dividedBy num denom = go num denom 0
130+
where
131+
go n d count
132+
| n < d = (count, n)
133+
| otherwise = go (n - d) d (count + 1)
134+
4135

5-
-- Example 1
6-
-- main :: IO ()
7-
-- main = hspec $ do
8-
-- describe "Addition" $ do
9-
-- it "1 + 1 is greater than 1" $ do
10-
-- (1 + 1) > 1 `shouldBe` True
11-
-- it "2 + 2 is equal to 4" $ do
12-
-- 2 + 2 `shouldBe` 4
13-
14-
-- Example 2
15-
-- dividedBy :: Integral a => a -> a -> (a, a)
16-
-- dividedBy num denom = go num denom 0
17-
-- where
18-
-- go n d count
19-
-- | n < d = (count, n)
20-
-- | otherwise = go (n - d) d (count + 1)
21-
--
22-
-- main :: IO ()
23-
-- main = hspec $ do
24-
-- describe "Addition" $ do
25-
-- it "15 divided by 3 is 5" $ do
26-
-- dividedBy 15 3 `shouldBe` (5, 0)
27-
-- it "22 divided by 5 is 4 remainder 2" $ do
28-
-- dividedBy 22 5 `shouldBe` (4, 2)
29-
30-
-- Short Exercise
31136
myMult :: (Eq a, Num a) => a -> a -> a
32137
myMult x y
33138
| sy == 0 || sy == 1 = go x y 0
@@ -38,21 +143,5 @@ myMult x y
38143
sy = signum y
39144
ax = abs x
40145
ay = abs y
41-
go _ 0 ab = ab
42-
go a b ab = go a (b - 1) (a + ab)
43-
44-
main :: IO ()
45-
main = hspec $ do
46-
describe "Multiplication" $ do
47-
it "5 multiplied by 0 is 0" $ do
48-
myMult 5 0 `shouldBe` 0
49-
it "0 multiplied by 5 is 0" $ do
50-
myMult 0 5 `shouldBe` 0
51-
it "2 multiplied by 3 is 6" $ do
52-
myMult 2 3 `shouldBe` 6
53-
it "-2 multiplied by 3 is -6" $ do
54-
myMult (-2) 3 `shouldBe` (-6)
55-
it "2 multiplied by -3 is -6" $ do
56-
myMult 2 (-3) `shouldBe` (-6)
57-
it "-2 multiplied by -3 is 6" $ do
58-
myMult (-2) (-3) `shouldBe` 6
146+
go x 0 xy = xy
147+
go x y xy = go x (y - 1) (x + xy)

‎ch14/addition/LICENSE

Lines changed: 0 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,30 +0,0 @@
1-
Copyright Dwayne Crooks (c) 2016
2-
3-
All rights reserved.
4-
5-
Redistribution and use in source and binary forms, with or without
6-
modification, are permitted provided that the following conditions are met:
7-
8-
* Redistributions of source code must retain the above copyright
9-
notice, this list of conditions and the following disclaimer.
10-
11-
* Redistributions in binary form must reproduce the above
12-
copyright notice, this list of conditions and the following
13-
disclaimer in the documentation and/or other materials provided
14-
with the distribution.
15-
16-
* Neither the name of Dwayne Crooks nor the names of other
17-
contributors may be used to endorse or promote products derived
18-
from this software without specific prior written permission.
19-
20-
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21-
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22-
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23-
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24-
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25-
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26-
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27-
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28-
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29-
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30-
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

‎ch14/addition/Setup.hs

Lines changed: 0 additions & 2 deletions
This file was deleted.

‎ch14/addition/addition.cabal

Lines changed: 15 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,17 @@
1-
name: addition
2-
version: 0.1.0.0
3-
synopsis: Simple project template from stack
4-
description: Please see README.md
5-
homepage: https://github.com/dwayne/addition#readme
6-
license: BSD3
7-
license-file: LICENSE
8-
author: Dwayne Crooks
9-
maintainer: me@dwaynecrooks.com
10-
copyright: 2016 Dwayne Crooks
11-
category: Text
12-
build-type: Simple
13-
cabal-version: >=1.10
1+
name: addition
2+
version: 0.1.0.0
3+
license-file: LICENSE
4+
author: Dwayne Crooks
5+
maintainer: sky@isfalling.org
6+
category: Text
7+
build-type: Simple
8+
cabal-version: >=1.10
149

1510
library
16-
hs-source-dirs: .
17-
exposed-modules: Addition
18-
ghc-options: -Wall -fwarn-tabs
19-
default-language: Haskell2010
20-
build-depends: base >= 4.7 && < 5
21-
, hspec
11+
exposed-modules: Addition
12+
ghc-options: -Wall -fwarn-tabs
13+
build-depends: base >=4.7 && <5
14+
, hspec
15+
, QuickCheck
16+
hs-source-dirs: .
17+
default-language: Haskell2010

‎ch14/addition/stack.yaml

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,25 +1,25 @@
11
# This file was automatically generated by 'stack init'
2-
#
2+
#
33
# Some commonly used options have been documented as comments in this file.
44
# For advanced use and comprehensive documentation of the format, please see:
55
# http://docs.haskellstack.org/en/stable/yaml_configuration/
66

77
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
88
# A snapshot resolver dictates the compiler version and the set of packages
99
# to be used for project dependencies. For example:
10-
#
10+
#
1111
# resolver: lts-3.5
1212
# resolver: nightly-2015-09-21
1313
# resolver: ghc-7.10.2
1414
# resolver: ghcjs-0.1.0_ghc-7.10.2
1515
# resolver:
1616
# name: custom-snapshot
1717
# location: "./custom-snapshot.yaml"
18-
resolver: lts-5.17
18+
resolver: lts-8.2
1919

2020
# User packages to be built.
2121
# Various formats can be used as shown in the example below.
22-
#
22+
#
2323
# packages:
2424
# - some-directory
2525
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
@@ -31,7 +31,7 @@ resolver: lts-5.17
3131
# subdirs:
3232
# - auto-update
3333
# - wai
34-
#
34+
#
3535
# A package marked 'extra-dep: true' will only be built if demanded by a
3636
# non-dependency (i.e. a user package), and its test suites and benchmarks
3737
# will not be run. This is useful for tweaking upstream packages.
@@ -49,18 +49,18 @@ extra-package-dbs: []
4949

5050
# Control whether we use the GHC we find on the path
5151
# system-ghc: true
52-
#
52+
#
5353
# Require a specific version of stack, using version ranges
5454
# require-stack-version: -any # Default
55-
# require-stack-version: ">=1.1"
56-
#
55+
# require-stack-version: ">=1.3"
56+
#
5757
# Override the architecture used by stack, especially useful on Windows
5858
# arch: i386
5959
# arch: x86_64
60-
#
60+
#
6161
# Extra directories used by stack for building
6262
# extra-include-dirs: [/path/to/dir]
6363
# extra-lib-dirs: [/path/to/dir]
64-
#
64+
#
6565
# Allow a newer minor version of GHC than the snapshot specifies
6666
# compiler-check: newer-minor

0 commit comments

Comments
 (0)