Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Moved stuff around

  • Loading branch information...
commit be9fc12b546c52c63479f930540d6282b03ee0e5 1 parent ed3dace
@tomlokhorst authored
Showing with 66 additions and 41 deletions.
  1. +28 −24 src/AwesomePrelude.hs
  2. +25 −5 src/JsPrelude.hs
  3. +13 −12 src/Main.hs
View
52 src/AwesomePrelude.hs
@@ -13,6 +13,7 @@ module AwesomePrelude where
undefined :: a
undefined = undefined
+-- A type class for the normal Prelude.Bool data type
class Bool f r | f -> r where
bool :: r -> r -> f -> r
false :: f
@@ -30,16 +31,22 @@ if' p t f = bool f t p
otherwise :: Bool b r => b
otherwise = true
+not :: (Bool b b', Bool b' r) => b -> b'
+not b = if' b false true
+
+-- A type class for the normal Prelude.Maybe data type
class Maybe f a r | f -> a, f -> r where
maybe :: r -> (a -> r) -> f a -> r
nothing :: f a
just :: a -> f a
+-- A type class for the normal Prelude.Either data type
class Either f a b r | f -> a, f -> b, f -> r where
either :: (a -> r) -> (b -> r) -> f a b -> r
left :: a -> f a b
right :: b -> f a b
+-- A type class for the normal Prelude pair: (,)
class Tuple2 f a b r | f -> a, f -> b, f -> r where
tuple2 :: (a -> b -> r) -> f a b -> r
ctuple2 :: a -> b -> f a b
@@ -56,18 +63,31 @@ curry f x y = f (ctuple2 x y)
uncurry :: (Tuple2 f a b r) => (a -> b -> r) -> f a b -> r
uncurry f t = tuple2 f t
-not :: (Bool b b', Bool b' r) => b -> b'
-not b = if' b false true
+class List f a r | f -> a, f -> r where
+ list :: r -> (a -> r -> r) -> f a -> r
+ nil :: f a
+ cons :: a -> f a -> f a
+
+map :: (List f a (g b), List g b r) => (a -> b) -> f a -> g b
+map f = list nil (\x ys -> f x `cons` ys)
+
+(++) :: (List f a (g a), List g a r) => f a -> g a -> g a
+xs ++ ys = list ys cons xs
+
+filter :: (List f a (g a), Bool b (g a), List g a r) =>
+ (a -> b) -> f a -> g a
+filter p = list nil (\x xs -> bool xs (x `cons` xs) (p x))
+-- An equivalent type class for the normal Prelude.Eq type class,
+-- now based on the Bool type class, instead of the Prelude.Bool data type
class Eq a b | a -> b where
(==), (/=) :: Bool b r => a -> a -> b
-
--- class (Eq f) => Ordering f r | f -> r where
--- ordering :: r -> r -> r -> f -> r
--- lt :: f
--- eq :: f
--- gt :: f
+class (Eq f r) => Ordering f r | f -> r where
+ ordering :: r -> r -> r -> f -> r
+ lt :: f
+ eq :: f
+ gt :: f
-- isLt :: (Ordering o b, Bool b r) => o -> b
-- isLt = ordering true false false
@@ -98,19 +118,3 @@ class Eq a b | a -> b where
--
-- max x y = if_ (x <= y) y x
-- min x y = if_ (x <= y) x y
-
-class List f a r | f -> a, f -> r where
- list :: r -> (a -> r -> r) -> f a -> r
- nil :: f a
- cons :: a -> f a -> f a
-
-map :: (List f a (g b), List g b r) => (a -> b) -> f a -> g b
-map f = list nil (\x ys -> f x `cons` ys)
-
-(++) :: (List f a (g a), List g a r) => f a -> g a -> g a
-xs ++ ys = list ys cons xs
-
-filter :: (List f a (g a), Bool b (g a), List g a r) =>
- (a -> b) -> f a -> g a
-filter p = list nil (\x xs -> bool xs (x `cons` xs) (p x))
-
View
30 src/JsPrelude.hs
@@ -52,10 +52,11 @@ showJs p@(App _ _) = fu p P.++ "(" P.++ intercalate "," (args p) P.++ ")"
args _ = []
data JsBool
+data JsNumber
data JsMaybe a
-data JsTuple2 a b
data JsEither a b
-data JsNumber
+data JsTuple2 a b
+data JsList a
fun :: [P.String] -> P.String -> P.String
fun ps ret = "(function (" P.++ intercalate ", " ps P.++ "){ return " P.++ ret P.++ "})"
@@ -71,10 +72,11 @@ instance P.Num (Js JsNumber) where
instance P.Eq (Js JsNumber) where
+
-- * JavaScript instances for AwesomePrelude 'data types'
instance Bool (Js JsBool) (Js r) where
- bool = TriOp "?" ":"
+ bool = \f t p -> TriOp "?" ":" p t f
true = Prim "true"
false = Prim "false"
@@ -89,20 +91,38 @@ instance Maybe (JsC1 JsMaybe) (Js a) (Js r) where
instance Either (JsC2 JsEither) (Js a) (Js b) (Js r) where
either f g e =
let e' = unJsC2 e
+<<<<<<< HEAD:src/JsPrelude.hs
patLeft = Destruct (fun ["x"] "x.left") e'
patRight = Destruct (fun ["x"] "x.right") e'
in prim3 (fun ["x", "y", "e"] "e.right === undefined ? x : y") (f patLeft) (g patRight) e'
left l = JsC2 (prim (fun ["x"] "{left : x}") l)
right r = JsC2 (prim (fun ["x"] "{right : x}") r)
+=======
+ patLeft = Destruct "(function (x) x.left)" e'
+ patRight = Destruct "(function (x) x.right)" e'
+ in prim3 "(function (x, y, e) e.right === undefined ? x : y)" (f patLeft) (g patRight) e'
+ left l = JsC2 (prim "(function (x) { return { left : x }})" l)
+ right r = JsC2 (prim "(function (x) { return {right : x }})" r)
+>>>>>>> Moved stuff around:src/JsPrelude.hs
instance Tuple2 (JsC2 JsTuple2) (Js a) (Js b) (Js r) where
tuple2 f p =
let p' = unJsC2 p
- patFst = Destruct ("(function (p) p.fst)") p'
- patSnd = Destruct ("(function (p) p.snd)") p'
+ patFst = Destruct "(function (p) p.fst)" p'
+ patSnd = Destruct "(function (p) p.snd)" p'
in prim "(function (z, p) z)" (f patFst patSnd)
ctuple2 x y = JsC2 (prim2 "(function (x, y) { return { fst : x, snd : y }})" x y)
+instance List (JsC1 JsList) (Js a) (Js r) where
+ -- list :: r -> (a -> r -> r) -> f a -> r
+ list x f ys =
+ let ys' = unJsC1 ys
+ patCons = Destruct "(function (x) x.cons)" ys'
+ in prim3 "(function (x, y, zs) zs.cons === undefined ? x : y" x (f patCons undefined) ys'
+ nil = JsC1 (Prim "{ }")
+ -- cons :: a -> f a -> f a
+ cons x xs = JsC2 (prim2 "(function (x, xs) { return { head : x, tail : xs }" x xs)
+
-- * JavaScript instances of AwesomePrelude 'type classes'
instance Eq (Js JsBool) (Js JsBool) where
View
25 src/Main.hs
@@ -39,25 +39,26 @@ test3 = fNumEq 3 4
+fM :: JsC1 JsMaybe (Js JsBool) -> Js JsBool
+--fM :: P.Maybe P.Bool -> P.Bool
+fM = maybe false not
+test4 = fM (just true)
listy :: [Int]
listy = 3 `cons` (4 `cons` nil)
--- bool' :: a -> a -> P.Bool -> a
--- bool' x y b = if b then x else y
---
--- f :: (forall a. a -> a -> b -> a) -> a -> b -> a
--- f g a b = g a a b
---
--- ok = f bool'
--- -- epicfail = f bool
---
--- hi = maybe false not
--- (just true :: P.Maybe P.Bool)
--- -- (just true :: JsC1 JsMaybe (Js JsBool))
+bool' :: a -> a -> P.Bool -> a
+bool' x y b = if b then x else y
+
+f :: (forall a. a -> a -> b -> a) -> a -> b -> a
+f g a b = g a a b
+
+ok = f bool'
+-- epicfail = f bool
+
--
-- yo = either (P.* 5) (P.const 2)
-- (right false :: P.Either P.Int P.Bool)
Please sign in to comment.
Something went wrong with that request. Please try again.