nu ook shallow dsl
[ap2015.git] / a10 / charlie / matcher_shallow.icl
1 module matcher_shallow
2
3 import StdEnv
4
5 EqualTo :: a a -> Bool | == a
6 EqualTo x y = x == y
7
8 LessThen :: a a -> Bool | < a
9 LessThen x y = y < x
10
11 Not :: (a -> Bool) a -> Bool
12 Not f x = not (f x)
13
14 Is :: (a -> Bool) a -> Bool
15 Is f x = f x
16
17 (Or) infixl 2 :: (a -> Bool) (a -> Bool) -> (a -> Bool)
18 (Or) f g = \x . f x || g x
19
20 AssertThat :: String a (a -> Bool) -> [String]
21 AssertThat id x f | f x = [id : " " : "PASS" : []]
22 | otherwise = [id : " " : "FAIL": []]
23
24 instance * [String] where
25 (*) x y = x ++ ["\n":y]
26
27 test :: [String] -> [String]
28 test x = x ++ ["\n"]
29
30 a1 = AssertThat "(2*2) (Is (EqualTo (2+2)))" (2*2) (Is(EqualTo (2+2)))
31 a2 = AssertThat "(3*3) (EqualTo (3+3))" (3*3) (EqualTo (3+3))
32 a3 = AssertThat "(length [0..3]) is not 4" (length [0..3]) (Not(EqualTo 4))
33
34 report = test (a1*a2*a3)
35
36 instance <<< [String] where
37 (<<<) file [] = file
38 (<<<) file [s:ss] = file <<< s <<< ss
39
40 Start :: !*World -> *World
41 Start world
42 # (file, world) = stdio world
43 # file = file <<< report
44 # (ok, world) = fclose file world
45 | otherwise = world