Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Added some helper functions, to remove warnings from Lang.JavaScript

  • Loading branch information...
commit c5d58d3108e79e50ed858b7eadfe6138e3e66920 1 parent 45d766d
Tom Lokhorst authored

Showing 1 changed file with 37 additions and 22 deletions. Show diff stats Hide diff stats

  1. +37 22 src/Lang/JavaScript.hs
59 src/Lang/JavaScript.hs
@@ -24,31 +24,31 @@ instance AppFunC (Val JS) where
24 24 app f x = App f x
25 25
26 26 instance RecFunC (Val JS) where
27   - fix f = fun1 "fix" (\[v] -> "fix = arguments.callee, " ++ v ++ "(function (i) { return fix(" ++ v ++ ")(i) })") (lam f)
  27 + fix f = fun1 "fix" (fun1' (\v -> "fix = arguments.callee, " ++ v ++ "(function (i) { return fix(" ++ v ++ ")(i) })")) (lam f)
28 28
29 29 instance BoolC (Val JS) where
30 30 false = Con "false"
31 31 true = Con "true"
32   - bool x y z = fun3 "bool" (\[f, t, b] -> b ++ " ? " ++ t ++ "(/*force*/) : " ++ f ++ "(/*force*/)") (lam (const x)) (lam (const y)) z
  32 + bool x y z = fun3 "bool" (fun3' (\f t b -> b ++ " ? " ++ t ++ "(/*force*/) : " ++ f ++ "(/*force*/)")) (lam (const x)) (lam (const y)) z
33 33
34 34 instance MaybeC (Val JS) where
35 35 nothing = Con "{ nothing : 1 }"
36   - just = fun1 "just" (\[x] -> "{ just : " ++ x ++ " }")
37   - maybe p q = fun3 "maybe" (\[n, j, m] -> m ++ ".nothing ? " ++ n ++ " : " ++ j ++ "(" ++ m ++ ".just)") p (lam q)
  36 + just = fun1 "just" (fun1' (\x -> "{ just : " ++ x ++ " }"))
  37 + maybe p q = fun3 "maybe" (fun3' (\n j m -> m ++ ".nothing ? " ++ n ++ " : " ++ j ++ "(" ++ m ++ ".just)")) p (lam q)
38 38
39 39 instance TupleC (Val JS) where
40   - mkTuple = fun2 "mkTuple" (\[a, b] -> "{ fst : " ++ a ++ ", snd : " ++ b ++ "}")
41   - tuple p q = fun2 "tuple" (\[f, t] -> f ++ "(" ++ t ++ ".fst, " ++ t ++ ".snd)") (lam2 p) q
  40 + mkTuple = fun2 "mkTuple" (fun2' (\a b -> "{ fst : " ++ a ++ ", snd : " ++ b ++ "}"))
  41 + tuple p q = fun2 "tuple" (fun2' (\f t -> f ++ "(" ++ t ++ ".fst, " ++ t ++ ".snd)")) (lam2 p) q
42 42
43 43 instance EitherC (Val JS) where
44   - left = fun1 "left" (\[l] -> "{ left : " ++ l ++ " }")
45   - right = fun1 "right" (\[r] -> "{ right : " ++ r ++ " }")
46   - either p q = fun3 "either" (\[l, r, e] -> e ++ ".left ? " ++ l ++ "(" ++ e ++ ".left) : " ++ r ++ "(" ++ e ++ ".right)") (lam p) (lam q)
  44 + left = fun1 "left" (fun1' (\l -> "{ left : " ++ l ++ " }"))
  45 + right = fun1 "right" (fun1' (\r -> "{ right : " ++ r ++ " }"))
  46 + either p q = fun3 "either" (fun3' (\l r e -> e ++ ".left ? " ++ l ++ "(" ++ e ++ ".left) : " ++ r ++ "(" ++ e ++ ".right)")) (lam p) (lam q)
47 47
48 48 instance ListC (Val JS) where
49 49 nil = Con "{ nil : 1 }"
50   - cons = fun2 "cons" (\[x, xs] -> "{ head : " ++ x ++ ", tail : " ++ xs ++ " }")
51   - list b f = fun3 "list" (\[n, c, xs] -> xs ++ ".nil ? " ++ n ++ " : " ++ c ++ "(" ++ xs ++ ".head)(" ++ xs ++ ".tail)") b (lam2 f)
  50 + cons = fun2 "cons" (fun2' (\x xs -> "{ head : " ++ x ++ ", tail : " ++ xs ++ " }"))
  51 + list b f = fun3 "list" (fun3' (\n c xs -> xs ++ ".nil ? " ++ n ++ " : " ++ c ++ "(" ++ xs ++ ".head)(" ++ xs ++ ".tail)")) b (lam2 f)
52 52
53 53
54 54 -- * JavaScript instances of AwesomePrelude type classes.
@@ -56,24 +56,39 @@ instance ListC (Val JS) where
56 56 data Number
57 57
58 58 instance Num (Val JS) Number where
59   - (+) = fun2 "add" (\[a, b] -> a ++ " + " ++ b)
60   - (-) = fun2 "sub" (\[a, b] -> a ++ " - " ++ b)
61   - (*) = fun2 "mul" (\[a, b] -> a ++ " * " ++ b)
  59 + (+) = fun2 "add" (op " + ")
  60 + (-) = fun2 "sub" (op " - ")
  61 + (*) = fun2 "mul" (op " * ")
62 62 fromInteger x = Con (P.show x)
63 63
64 64 instance Eq (Val JS) Bool where
65   - (==) = fun2 "eq" (\[a, b] -> a ++ " == " ++ b)
66   - (/=) = fun2 "neq" (\[a, b] -> a ++ " /= " ++ b)
  65 + (==) = fun2 "eq" (op " == ")
  66 + (/=) = fun2 "neq" (op " /= ")
67 67
68 68 instance Eq (Val JS) Number where
69   - (==) = fun2 "eq" (\[a, b] -> a ++ " == " ++ b)
70   - (/=) = fun2 "neq" (\[a, b] -> a ++ " /= " ++ b)
  69 + (==) = fun2 "eq" (op " == ")
  70 + (/=) = fun2 "neq" (op " /= ")
71 71
72 72 instance (Eq (Val JS) a, Eq (Val JS) b) => Eq (Val JS) (a, b) where
73   - (==) = fun2 "eq" (\[a, b] -> a ++ " == " ++ b)
74   - (/=) = fun2 "neq" (\[a, b] -> a ++ " /= " ++ b)
  73 + (==) = fun2 "eq" (op " == ")
  74 + (/=) = fun2 "neq" (op " /= ")
75 75
76 76 instance Eq (Val JS) a => Eq (Val JS) [a] where
77   - (==) = fun2 "eq" (\[a, b] -> a ++ " == " ++ b)
78   - (/=) = fun2 "neq" (\[a, b] -> a ++ " /= " ++ b)
  77 + (==) = fun2 "eq" (op " == ")
  78 + (/=) = fun2 "neq" (op " /= ")
  79 +
  80 +op :: P.String -> [P.String] -> P.String
  81 +op s = fun2' (\x y -> x ++ s ++ y)
  82 +
  83 +fun1' :: (P.String -> P.String) -> [P.String] -> P.String
  84 +fun1' f [x] = f x
  85 +fun1' _ _ = P.error "Lang.JavaScript.fun1': wrong number of arguments"
  86 +
  87 +fun2' :: (P.String -> P.String -> P.String) -> [P.String] -> P.String
  88 +fun2' f [x, y] = f x y
  89 +fun2' _ _ = P.error "Lang.JavaScript.fun2': wrong number of arguments"
  90 +
  91 +fun3' :: (P.String -> P.String -> P.String -> P.String) -> [P.String] -> P.String
  92 +fun3' f [x, y, z] = f x y z
  93 +fun3' _ _ = P.error "Lang.JavaScript.fun3': wrong number of arguments"
79 94

0 comments on commit c5d58d3

Please sign in to comment.
Something went wrong with that request. Please try again.