-
Notifications
You must be signed in to change notification settings - Fork 0
/
types.hs
141 lines (103 loc) · 3.86 KB
/
types.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
module Types
( Point(..)
, Shape(..)
, surface
, nudge
, baseCircle
, baseRect
, Person
) where
import qualified Data.Map as Map
data Shape = Circle Point Float
| Rectangle Point Point
deriving (Show)
data Point = Point Float Float deriving (Show)
origin = Point 0 0
surface :: Shape -> Float
surface (Circle _ r) = pi * r ^ 2
surface (Rectangle (Point x1 y1) (Point x2 y2)) = (abs $ x2 - x1) * (abs $ y2 - y1)
nudge :: Shape -> Point -> Shape
nudge (Circle (Point x y) r) (Point a b) = Circle (Point (x+a) (y+b)) r
nudge (Rectangle (Point x1 y1) (Point x2 y2)) (Point a b) = Rectangle (Point (x1+a) (y1+b)) (Point (x2+a) (y2+b))
baseCircle :: Float -> Shape
baseCircle = Circle origin
baseRect :: Float -> Float -> Shape
baseRect width height = Rectangle origin $ Point width height
data Person = Person { firstName :: String
, lastName :: String
, age :: Int
} deriving (Eq, Show, Read)
data Vector a = Vector a a a deriving (Show)
vplus :: (Num t) => Vector t -> Vector t -> Vector t
(Vector i j k) `vplus` (Vector l m n) = Vector (i+l) (j+m) (k+n)
vectMult :: (Num t) => Vector t -> t -> Vector t
(Vector i j k) `vectMult` m = Vector (i*m) (j*m) (k*m)
scalarMult :: (Num t) => Vector t -> Vector t -> t
(Vector i j k) `scalarMult` (Vector l m n) = i*l + j*m + k*n
data Day = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday
deriving (Eq, Ord, Show, Read, Bounded, Enum)
data LockerState = Taken | Free deriving (Show, Eq)
type Code = String
type LockerMap = Map.Map Int (LockerState, Code)
lockerLookup :: Int -> LockerMap -> Either String Code
lockerLookup lockerNumber map =
case Map.lookup lockerNumber map of
Nothing -> Left $ "Locker number" ++ show lockerNumber ++ " doesn't exist!"
Just (state, code) -> if state == Taken
then Left $ "Locker " ++ show lockerNumber ++ " is already taken!"
else Right code
infixr 5 :-:
data List a = Empty | a :-: (List a) deriving (Show, Read, Eq, Ord)
infixr 5 .++
(.++) :: List a -> List a -> List a
Empty .++ ys = ys
(x:-:xs) .++ ys = x :-: (xs .++ ys)
data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show, Read, Eq)
singleton :: a -> Tree a
singleton x = Node x EmptyTree EmptyTree
treeInsert :: (Ord a) => a -> Tree a -> Tree a
treeInsert x EmptyTree = singleton x
treeInsert x (Node y left right)
| x == y = Node x left right
| x < y = Node y (treeInsert x left) right
| x > y = Node y left (treeInsert x right)
treeElem :: (Ord a) => a -> Tree a -> Bool
treeElem _ EmptyTree = False
treeElem x (Node y left right)
| x == y = True
| x < y = treeElem x left
| x > y = treeElem x right
data TrafficLight = Red | Yellow | Green
instance Eq TrafficLight where
Red == Red = True
Yellow == Yellow = True
Green == Green = True
_ == _ = False
instance Show TrafficLight where
show Red = "Red light"
show Yellow = "Yellow light"
show Green = "Green light"
class YesNo a where
yesno :: a -> Bool
instance YesNo Int where
yesno 0 = False
yesno _ = True
instance YesNo [a] where
yesno [] = False
yesno _ = True
instance YesNo Bool where
yesno = id
instance YesNo (Maybe a) where
yesno Nothing = False
yesno (Just _) = True
instance YesNo (Tree a) where
yesno EmptyTree = False
yesno _ = True
instance YesNo TrafficLight where
yesno Red = False
yesno _ = True
yesnoIf :: (YesNo y) => y -> a -> a -> a
yesnoIf val yes no = if yesno val then yes else no
instance Functor Tree where
fmap f EmptyTree = EmptyTree
fmap f (Node x left right) = Node (f x) (fmap f left) (fmap f right)