Skip to content

Commit a9b54d8

Browse files
authored
Ch5 - Convert unnecessary ADTs to type synonyms and add anchors (#254)
* Ch5 - remove getX getY * Ch5 - Further simplify centerShape * Ch5 - Use type synonym instead of ADT for Point * Ch5 - improve Newtype section * Ch6 - convert Show Point exercise from data to newtype * Ch5 - anchors and chapter example tests * Ch5 - Relocate and edit Record Puns section * Ch5 - Do not use ADT for Bounds * Ch5 - CI fix, add chapter examples
1 parent 4661462 commit a9b54d8

File tree

7 files changed

+353
-213
lines changed

7 files changed

+353
-213
lines changed
Lines changed: 129 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,129 @@
1+
module ChapterExamples where
2+
3+
import Prelude hiding (gcd)
4+
-- ANCHOR: lzsImport
5+
import Data.Array (tail)
6+
import Data.Foldable (sum)
7+
import Data.Maybe (fromMaybe)
8+
-- ANCHOR_END: lzsImport
9+
-- ANCHOR: unsafePartialImport
10+
import Partial.Unsafe (unsafePartial)
11+
-- ANCHOR_END: unsafePartialImport
12+
13+
-- ANCHOR: gcd
14+
gcd :: Int -> Int -> Int
15+
gcd n 0 = n
16+
gcd 0 m = m
17+
gcd n m = if n > m
18+
then gcd (n - m) m
19+
else gcd n (m - n)
20+
-- ANCHOR_END: gcd
21+
22+
-- ANCHOR: fromString
23+
fromString :: String -> Boolean
24+
fromString "true" = true
25+
fromString _ = false
26+
-- ANCHOR_END: fromString
27+
28+
-- ANCHOR: toString
29+
toString :: Boolean -> String
30+
toString true = "true"
31+
toString false = "false"
32+
-- ANCHOR_END: toString
33+
34+
-- ANCHOR: gcdV2
35+
gcdV2 :: Int -> Int -> Int
36+
gcdV2 n 0 = n
37+
gcdV2 0 n = n
38+
gcdV2 n m | n > m = gcdV2 (n - m) m
39+
| otherwise = gcdV2 n (m - n)
40+
-- ANCHOR_END: gcdV2
41+
42+
-- ANCHOR: isEmpty
43+
isEmpty :: forall a. Array a -> Boolean
44+
isEmpty [] = true
45+
isEmpty _ = false
46+
-- ANCHOR_END: isEmpty
47+
48+
-- ANCHOR: takeFive
49+
takeFive :: Array Int -> Int
50+
takeFive [0, 1, a, b, _] = a * b
51+
takeFive _ = 0
52+
-- ANCHOR_END: takeFive
53+
54+
-- ANCHOR: showPerson
55+
showPerson :: { first :: String, last :: String } -> String
56+
showPerson { first: x, last: y } = y <> ", " <> x
57+
-- ANCHOR_END: showPerson
58+
59+
-- ANCHOR: showPersonV2
60+
showPersonV2 :: { first :: String, last :: String } -> String
61+
showPersonV2 { first, last } = last <> ", " <> first
62+
-- ANCHOR_END: showPersonV2
63+
64+
-- ANCHOR: unknownPerson
65+
unknownPerson :: { first :: String, last :: String }
66+
unknownPerson = { first, last }
67+
where
68+
first = "Jane"
69+
last = "Doe"
70+
-- ANCHOR_END: unknownPerson
71+
72+
-- ANCHOR: livesInLA
73+
type Address = { street :: String, city :: String }
74+
75+
type Person = { name :: String, address :: Address }
76+
77+
livesInLA :: Person -> Boolean
78+
livesInLA { address: { city: "Los Angeles" } } = true
79+
livesInLA _ = false
80+
-- ANCHOR_END: livesInLA
81+
82+
-- ANCHOR: sortPair
83+
sortPair :: Array Int -> Array Int
84+
sortPair arr@[x, y]
85+
| x <= y = arr
86+
| otherwise = [y, x]
87+
sortPair arr = arr
88+
-- ANCHOR_END: sortPair
89+
90+
-- ANCHOR: lzs
91+
lzs :: Array Int -> Array Int
92+
lzs [] = []
93+
lzs xs = case sum xs of
94+
0 -> xs
95+
_ -> lzs (fromMaybe [] $ tail xs)
96+
-- ANCHOR_END: lzs
97+
98+
-- ANCHOR: partialFunction
99+
partialFunction :: Boolean -> Boolean
100+
partialFunction = unsafePartial \true -> true
101+
-- ANCHOR_END: partialFunction
102+
103+
-- ANCHOR: electricalUnits
104+
newtype Volt = Volt Number
105+
newtype Ohm = Ohm Number
106+
newtype Amp = Amp Number
107+
-- ANCHOR_END: electricalUnits
108+
109+
-- ANCHOR: calculateCurrent
110+
calculateCurrent :: Volt -> Ohm -> Amp
111+
calculateCurrent (Volt v) (Ohm r) = Amp (v / r)
112+
113+
battery :: Volt
114+
battery = Volt 1.5
115+
116+
lightbulb :: Ohm
117+
lightbulb = Ohm 500.0
118+
119+
current :: Amp
120+
current = calculateCurrent battery lightbulb
121+
-- ANCHOR_END: calculateCurrent
122+
123+
-- These are to enable testing. Will be explained in Ch6.
124+
derive newtype instance eqAmp :: Eq Amp
125+
derive newtype instance showAmp :: Show Amp
126+
127+
-- ANCHOR: Watt
128+
newtype Watt = MakeWatt Number
129+
-- ANCHOR_END: Watt

exercises/chapter5/src/Data/Picture.purs

Lines changed: 52 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -1,32 +1,36 @@
1+
-- ANCHOR: module_picture
12
module Data.Picture where
23

34
import Prelude
4-
55
import Data.Foldable (foldl)
6+
-- ANCHOR_END: module_picture
7+
-- ANCHOR: picture_import_as
68
import Global as Global
79
import Math as Math
10+
-- ANCHOR_END: picture_import_as
811

9-
data Point = Point
12+
-- ANCHOR: Point
13+
type Point =
1014
{ x :: Number
1115
, y :: Number
1216
}
17+
-- ANCHOR_END: Point
1318

14-
getX :: Point -> Number
15-
getX (Point p) = p.x
16-
17-
getY :: Point -> Number
18-
getY (Point p) = p.y
19-
19+
-- ANCHOR: showPoint
2020
showPoint :: Point -> String
21-
showPoint (Point { x, y }) =
21+
showPoint { x, y } =
2222
"(" <> show x <> ", " <> show y <> ")"
23+
-- ANCHOR_END: showPoint
2324

25+
-- ANCHOR: Shape
2426
data Shape
2527
= Circle Point Number
2628
| Rectangle Point Number Number
2729
| Line Point Point
2830
| Text Point String
31+
-- ANCHOR_END: Shape
2932

33+
-- ANCHOR: showShape
3034
showShape :: Shape -> String
3135
showShape (Circle c r) =
3236
"Circle [center: " <> showPoint c <> ", radius: " <> show r <> "]"
@@ -36,115 +40,132 @@ showShape (Line start end) =
3640
"Line [start: " <> showPoint start <> ", end: " <> showPoint end <> "]"
3741
showShape (Text loc text) =
3842
"Text [location: " <> showPoint loc <> ", text: " <> show text <> "]"
43+
-- ANCHOR_END: showShape
44+
45+
-- ANCHOR: exampleLine
46+
exampleLine :: Shape
47+
exampleLine = Line p1 p2
48+
where
49+
p1 :: Point
50+
p1 = { x: 0.0, y: 0.0 }
51+
52+
p2 :: Point
53+
p2 = { x: 100.0, y: 50.0 }
54+
-- ANCHOR_END: exampleLine
3955

56+
-- ANCHOR: origin
4057
origin :: Point
41-
origin = Point { x: 0.0, y: 0.0 }
58+
origin = { x, y }
59+
where
60+
x = 0.0
61+
y = 0.0
62+
-- ANCHOR_END: origin
63+
-- Would generally write it like this instead:
64+
-- origin = { x: 0.0, y: 0.0 }
4265

4366
getCenter :: Shape -> Point
4467
getCenter (Circle c r) = c
4568
getCenter (Rectangle c w h) = c
46-
getCenter (Line (Point s) (Point e)) = Point { x: (s.x + e.x) / 2.0, y: (s.y + e.y) / 2.0 }
69+
getCenter (Line s e) = (s + e) * {x: 0.5, y: 0.5}
4770
getCenter (Text loc text) = loc
4871

72+
-- ANCHOR: Picture
4973
type Picture = Array Shape
74+
-- ANCHOR_END: Picture
5075

76+
-- ANCHOR: showPicture
5177
showPicture :: Picture -> Array String
5278
showPicture = map showShape
79+
-- ANCHOR_END: showPicture
5380

54-
data Bounds = Bounds
81+
-- ANCHOR: Bounds
82+
type Bounds =
5583
{ top :: Number
5684
, left :: Number
5785
, bottom :: Number
5886
, right :: Number
5987
}
88+
-- ANCHOR_END: Bounds
6089

6190
showBounds :: Bounds -> String
62-
showBounds (Bounds b) =
91+
showBounds b =
6392
"Bounds [top: " <> show b.top <>
6493
", left: " <> show b.left <>
6594
", bottom: " <> show b.bottom <>
6695
", right: " <> show b.right <>
6796
"]"
6897

6998
shapeBounds :: Shape -> Bounds
70-
shapeBounds (Circle (Point { x, y }) r) = Bounds
99+
shapeBounds (Circle { x, y } r) =
71100
{ top: y - r
72101
, left: x - r
73102
, bottom: y + r
74103
, right: x + r
75104
}
76-
shapeBounds (Rectangle (Point { x, y }) w h) = Bounds
105+
shapeBounds (Rectangle { x, y } w h) =
77106
{ top: y - h / 2.0
78107
, left: x - w / 2.0
79108
, bottom: y + h / 2.0
80109
, right: x + w / 2.0
81110
}
82-
shapeBounds (Line (Point p1) (Point p2)) = Bounds
111+
shapeBounds (Line p1 p2) =
83112
{ top: Math.min p1.y p2.y
84113
, left: Math.min p1.x p2.x
85114
, bottom: Math.max p1.y p2.y
86115
, right: Math.max p1.x p2.x
87116
}
88-
shapeBounds (Text (Point { x, y }) _) = Bounds
117+
shapeBounds (Text { x, y } _) =
89118
{ top: y
90119
, left: x
91120
, bottom: y
92121
, right: x
93122
}
94123

95124
union :: Bounds -> Bounds -> Bounds
96-
union (Bounds b1) (Bounds b2) = Bounds
125+
union b1 b2 =
97126
{ top: Math.min b1.top b2.top
98127
, left: Math.min b1.left b2.left
99128
, bottom: Math.max b1.bottom b2.bottom
100129
, right: Math.max b1.right b2.right
101130
}
102131

103132
intersect :: Bounds -> Bounds -> Bounds
104-
intersect (Bounds b1) (Bounds b2) = Bounds
133+
intersect b1 b2 =
105134
{ top: Math.max b1.top b2.top
106135
, left: Math.max b1.left b2.left
107136
, bottom: Math.min b1.bottom b2.bottom
108137
, right: Math.min b1.right b2.right
109138
}
110139

111140
emptyBounds :: Bounds
112-
emptyBounds = Bounds
141+
emptyBounds =
113142
{ top: Global.infinity
114143
, left: Global.infinity
115144
, bottom: -Global.infinity
116145
, right: -Global.infinity
117146
}
118147

119148
infiniteBounds :: Bounds
120-
infiniteBounds = Bounds
149+
infiniteBounds =
121150
{ top: -Global.infinity
122151
, left: -Global.infinity
123152
, bottom: Global.infinity
124153
, right: Global.infinity
125154
}
126155

156+
-- ANCHOR: bounds
127157
bounds :: Picture -> Bounds
128158
bounds = foldl combine emptyBounds
129159
where
130160
combine :: Bounds -> Shape -> Bounds
131161
combine b shape = union (shapeBounds shape) b
162+
-- ANCHOR_END: bounds
132163

133164
{-
134165
These `instance`s are to enable testing.
135166
Feel free to ignore these.
136167
They'll make more sense in the next chapter.
137168
-}
138-
derive instance boundsEq :: Eq Bounds
139-
140-
instance boundsShow :: Show Bounds where
141-
show b = showBounds b
142-
143-
derive instance pointEq :: Eq Point
144-
145-
instance pointShow :: Show Point where
146-
show p = showPoint p
147-
148169
derive instance shapeEq :: Eq Shape
149170

150171
instance shapeShow :: Show Shape where

0 commit comments

Comments
 (0)