Natrual/Main.hs at main · willdoescode/Natrual · GitHub

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
import Test.HUnit

data Nat = Z | S Nat deriving (Eq)

natToInt :: Nat -> Int
natToInt Z = 0
natToInt (S k) = 1 + natToInt k

instance Show Nat where
  show = show . natToInt

instance Num Nat where
  fromInteger 0 = Z
  fromInteger n = S $ fromInteger $ n - 1

  (+) n Z = n
  (+) a (S k) = S $ a + k

  (*) Z n = Z
  (*) n (S k) = k * n + n

  abs _ = Z
  signum _ = Z
  (-) _ _ = Z

testAddNat :: Test
testAddNat =
  TestCase $
    assertEqual
      "Nats should add correctly"
      (S (S (S (S (S (S (S (S (S Z)))))))))
      ((4 :: Nat) + (5 :: Nat))

testMultNat :: Test
testMultNat =
  TestCase $
    assertEqual
      "Nats should multiply correctly"
      (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S Z))))))))))))))))))))
      ((4 :: Nat) * (5 :: Nat))

testShowNat :: Test
testShowNat =
  TestCase $
    assertEqual
      "Nat should convert to string correctly"
      "5"
      (show (S (S (S (S (S Z))))))

testOrderOfOperations :: Test
testOrderOfOperations =
  TestCase $
    assertEqual
      "Nats should add and multiply in the correct direction"
      (S (S (S (S (S (S (S (S Z))))))))
      ((2 :: Nat) * (3 :: Nat) + (2 :: Nat))

main :: IO Counts
main = runTestTT $ TestList [testAddNat, testMultNat, testShowNat, testOrderOfOperations]