Skip to content

Commit 66d1a09

Browse files
paf31paf31
committed
Update trypurescript for psc 0.4.9
1 parent b91ca3a commit 66d1a09

File tree

3 files changed

+206
-186
lines changed

3 files changed

+206
-186
lines changed

‎Main.hs

Lines changed: 46 additions & 183 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,8 @@ module Main (
2121
import Web.Scotty
2222
import qualified Language.PureScript as P
2323

24+
import Data.Version (showVersion)
25+
2426
import Data.Monoid
2527
import Data.String
2628
import Data.Maybe (mapMaybe)
@@ -34,6 +36,12 @@ import Text.Blaze.Html
3436
import Text.Blaze.Html.Renderer.Text
3537
import qualified Text.Blaze.Html5 as H
3638
import qualified Text.Blaze.Html5.Attributes as A
39+
import qualified System.IO.UTF8 as U
40+
41+
import qualified Paths_trypurescript as Paths
42+
43+
preludeFilename :: IO FilePath
44+
preludeFilename = Paths.getDataFileName "prelude/prelude.purs"
3745

3846
data Compiled = Compiled { js :: String
3947
, externs :: String
@@ -42,9 +50,7 @@ data Compiled = Compiled { js :: String
4250
data Response = Response (Either String Compiled)
4351

4452
options :: P.Options
45-
options = P.defaultOptions { P.optionsTco = True
46-
, P.optionsMagicDo = True
47-
, P.optionsModules = ["Main"] }
53+
options = P.defaultOptions { P.optionsModules = ["Main"] }
4854

4955
compile :: [P.Module] -> String -> IO Response
5056
compile _ input | length input > 5000 = return $ Response $ Left "Please limit your input to 5000 characters"
@@ -65,156 +71,6 @@ str = id
6571
mono :: H.Html -> H.Html
6672
mono h = h ! A.class_ "mono"
6773

68-
prelude :: String
69-
prelude = unlines
70-
[
71-
"module Prelude where",
72-
"",
73-
"infixr 0 $",
74-
"",
75-
"($) :: forall a b. (a -> b) -> a -> b",
76-
"($) f x = f x",
77-
"",
78-
"class Monad m where",
79-
" ret :: forall a. a -> m a",
80-
" (>>=) :: forall a b. m a -> (a -> m b) -> m b",
81-
"",
82-
"infixl 7 *",
83-
"infixl 7 /",
84-
"infixl 7 %",
85-
"",
86-
"infixl 6 -",
87-
"infixl 6 +",
88-
"",
89-
"class Num a where",
90-
" (+) :: a -> a -> a",
91-
" (-) :: a -> a -> a",
92-
" (*) :: a -> a -> a",
93-
" (/) :: a -> a -> a",
94-
" (%) :: a -> a -> a",
95-
" negate :: a -> a",
96-
"",
97-
"foreign import numAdd :: Number -> Number -> Number",
98-
"foreign import numSub :: Number -> Number -> Number",
99-
"foreign import numMul :: Number -> Number -> Number",
100-
"foreign import numDiv :: Number -> Number -> Number",
101-
"foreign import numMod :: Number -> Number -> Number",
102-
"foreign import numNegate :: Number -> Number",
103-
"",
104-
"instance Num Number where",
105-
" (+) = numAdd",
106-
" (-) = numSub",
107-
" (*) = numMul",
108-
" (/) = numDiv",
109-
" (%) = numMod",
110-
" negate = numNegate",
111-
"",
112-
"infixl 4 ==",
113-
"infixl 4 /=",
114-
"",
115-
"class Eq a where",
116-
" (==) :: a -> a -> Boolean",
117-
" (/=) :: a -> a -> Boolean",
118-
"",
119-
"foreign import unsafeRefEq :: forall a. a -> a -> Boolean",
120-
"foreign import unsafeRefIneq :: forall a. a -> a -> Boolean",
121-
"",
122-
"instance Eq String where",
123-
" (==) = unsafeRefEq",
124-
" (/=) = unsafeRefIneq",
125-
"",
126-
"instance Eq Number where",
127-
" (==) = unsafeRefEq",
128-
" (/=) = unsafeRefIneq",
129-
"",
130-
"instance Eq Boolean where",
131-
" (==) = unsafeRefEq",
132-
" (/=) = unsafeRefIneq",
133-
"",
134-
"instance (Eq a) => Eq [a] where",
135-
" (==) [] [] = true",
136-
" (==) (x:xs) (y:ys) = x == y && xs == ys",
137-
" (==) _ _ = false",
138-
" (/=) xs ys = not (xs == ys)",
139-
"",
140-
"infixl 4 <",
141-
"infixl 4 >",
142-
"infixl 4 <=",
143-
"infixl 4 >=",
144-
"",
145-
"class Ord a where",
146-
" (<) :: a -> a -> Boolean",
147-
" (>) :: a -> a -> Boolean",
148-
" (<=) :: a -> a -> Boolean",
149-
" (>=) :: a -> a -> Boolean",
150-
"",
151-
"foreign import numLess :: Number -> Number -> Boolean",
152-
"foreign import numLessEq :: Number -> Number -> Boolean",
153-
"foreign import numGreater :: Number -> Number -> Boolean",
154-
"foreign import numGreaterEq :: Number -> Number -> Boolean",
155-
"",
156-
"instance Ord Number where",
157-
" (<) = numLess",
158-
" (>) = numGreater",
159-
" (<=) = numLessEq",
160-
" (>=) = numGreaterEq",
161-
"",
162-
"infixl 10 &",
163-
"infixl 10 |",
164-
"infixl 10 ^",
165-
"",
166-
"class Bits b where",
167-
" (&) :: b -> b -> b",
168-
" (|) :: b -> b -> b",
169-
" (^) :: b -> b -> b",
170-
" shl :: b -> Number -> b",
171-
" shr :: b -> Number -> b",
172-
" zshr :: b -> Number -> b",
173-
" complement :: b -> b",
174-
"",
175-
"foreign import numShl :: Number -> Number -> Number",
176-
"foreign import numShr :: Number -> Number -> Number",
177-
"foreign import numZshr :: Number -> Number -> Number",
178-
"foreign import numAnd :: Number -> Number -> Number",
179-
"foreign import numOr :: Number -> Number -> Number",
180-
"foreign import numXor :: Number -> Number -> Number",
181-
"foreign import numComplement :: Number -> Number",
182-
"",
183-
"instance Bits Number where",
184-
" (&) = numAnd",
185-
" (|) = numOr",
186-
" (^) = numXor",
187-
" shl = numShl",
188-
" shr = numShr",
189-
" zshr = numZshr",
190-
" complement = numComplement",
191-
"",
192-
"infixl 8 !!",
193-
"",
194-
"foreign import (!!) :: forall a. [a] -> Number -> a",
195-
"",
196-
"infixr 2 ||",
197-
"infixr 3 &&",
198-
"",
199-
"class BoolLike b where",
200-
" (&&) :: b -> b -> b",
201-
" (||) :: b -> b -> b",
202-
" not :: b -> b",
203-
"",
204-
"foreign import boolAnd :: Boolean -> Boolean -> Boolean",
205-
"foreign import boolOr :: Boolean -> Boolean -> Boolean",
206-
"foreign import boolNot :: Boolean -> Boolean",
207-
"",
208-
"instance BoolLike Boolean where",
209-
" (&&) = boolAnd",
210-
" (||) = boolOr",
211-
" not = boolNot",
212-
"",
213-
"infixr 5 ++",
214-
"",
215-
"foreign import (++) :: String -> String -> String"
216-
]
217-
21874
examplesJs :: String
21975
examplesJs = unlines
22076
[ "$('#examples').change(function() {"
@@ -302,7 +158,7 @@ examples =
302158
("Operators",
303159
unlines [ "module Main where"
304160
, ""
305-
, "import Prelude"
161+
, "import Prelude ()"
306162
, ""
307163
, "infixl 5 >>>"
308164
, ""
@@ -349,22 +205,19 @@ examples =
349205
unlines [ "module Main where"
350206
, ""
351207
, "import Prelude"
208+
, "import Control.Monad.Eff"
209+
, "import Control.Monad.ST"
352210
, ""
353211
, "collatz :: Number -> Number"
354-
, "collatz n ="
355-
, " { "
356-
, " var m = n;"
357-
, " var count = 0;"
358-
, " while (m > 1) {"
359-
, " if (m % 2 == 0) {"
360-
, " m = m / 2;"
361-
, " } else {"
362-
, " m = 3 * m + 1;"
363-
, " }"
364-
, " count = count + 1;"
365-
, " }"
366-
, " return count;"
367-
, " }"
212+
, "collatz n = runPure (runST (do"
213+
, " r <- newSTRef n"
214+
, " count <- newSTRef 0"
215+
, " untilE $ do"
216+
, " modifySTRef count $ (+) 1"
217+
, " m <- readSTRef r"
218+
, " writeSTRef r $ if m % 2 == 0 then m / 2 else 3 * m + 1"
219+
, " return $ m == 1"
220+
, " readSTRef count))"
368221
]))
369222
, ("modules",
370223
("Modules",
@@ -418,8 +271,8 @@ examples =
418271
, ""
419272
, "data Maybe a = Nothing | Just a"
420273
, ""
421-
, "instance Prelude.Monad Maybe where"
422-
, " ret = Just"
274+
, "instance monadMaybe :: Prelude.Monad Maybe where"
275+
, " return = Just"
423276
, " (>>=) Nothing _ = Nothing"
424277
, " (>>=) (Just a) f = f a"
425278
, ""
@@ -431,7 +284,7 @@ examples =
431284
, " m <- b"
432285
, " let sum = n + m"
433286
, " isEven sum"
434-
, " ret sum"
287+
, " return sum"
435288
]))
436289
, ("tco",
437290
("Tail-Call Elimination",
@@ -448,25 +301,25 @@ examples =
448301
("Type Classes",
449302
unlines [ "module Main where"
450303
, ""
451-
, "import Prelude"
304+
, "import Prelude ((++))"
452305
, ""
453306
, "class Show a where"
454307
, " show :: a -> String"
455308
, ""
456-
, "instance Show String where"
309+
, "instance showString :: Show String where"
457310
, " show s = s"
458311
, ""
459-
, "instance Show Boolean where"
312+
, "instance showBoolean :: Show Boolean where"
460313
, " show true = \"true\""
461314
, " show false = \"false\""
462315
, ""
463-
, "instance (Show a) => Show [a] where"
464-
, " show arr = \"[\" ++ showArray arr ++ \"]\""
465-
, ""
466-
, "showArray :: forall a. (Show a) => [a] -> String"
467-
, "showArray [] = \"\""
468-
, "showArray [x] = show x"
469-
, "showArray (x:xs) = show x ++ \", \" ++ showArray xs"
316+
, "instance showArray :: (Show a) => Show [a] where"
317+
, " show arr = \"[\" ++ go arr ++ \"]\""
318+
, " where"
319+
, " go :: forall a. (Show a) => [a] -> String"
320+
, " go [] = \"\""
321+
, " go [x] = show x"
322+
, " go (x:xs) = show x ++ \", \" ++ go xs"
470323
, ""
471324
, "test = show [true, false]"
472325
]))
@@ -530,10 +383,20 @@ responseToJs (Just (Response (Right (Compiled js _)))) = (True, js)
530383

531384
server :: Int -> IO ()
532385
server port = do
386+
prelude <- preludeFilename >>= U.readFile
533387
let preludeModules = either (error . show) id $ P.runIndentParser "" P.parseModules prelude
534388
scotty port $ do
535389
get "/" $ do
536-
page Nothing (Just "-- Type PureScript code here and click 'Compile' ...\r\n-- \r\n-- Or select an example from the list at the top right of the page") Nothing
390+
page Nothing (Just (unlines [ "-- Type PureScript code here and click 'Compile' ..."
391+
, "-- "
392+
, "-- Or select an example from the list at the top right of the page"
393+
, ""
394+
, "module Main where"
395+
, ""
396+
, "import Debug.Trace"
397+
, ""
398+
, "main = trace \"Hello, World!\""
399+
])) Nothing
537400
get "/example/:name" $ do
538401
name <- param "name"
539402
case lookup name examples of
@@ -556,7 +419,7 @@ port = value $ opt 80 $ (optInfo [ "p", "port" ])
556419
termInfo :: TermInfo
557420
termInfo = defTI
558421
{ termName = "trypurescript"
559-
, version = "0.1.0.0"
422+
, version = showVersion Paths.version
560423
, termDoc = "Try PureScript in the browser"
561424
}
562425

0 commit comments

Comments
 (0)