Skip to content

Commit 8ccb464

Browse files
paf31paf31
committed
Update trypurescript to use psc v.4
1 parent f62baf7 commit 8ccb464

File tree

3 files changed

+323
-44
lines changed

3 files changed

+323
-44
lines changed

‎Main.hs

Lines changed: 68 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,10 @@ import Text.Blaze.Html
3434
import Text.Blaze.Html.Renderer.Text
3535
import qualified Text.Blaze.Html5 as H
3636
import qualified Text.Blaze.Html5.Attributes as A
37+
import qualified Paths_trypurescript as Paths
38+
39+
getPreludeFilename :: IO FilePath
40+
getPreludeFilename = Paths.getDataFileName "prelude.purs"
3741

3842
data Compiled = Compiled { js :: String
3943
, externs :: String
@@ -42,16 +46,23 @@ data Compiled = Compiled { js :: String
4246
data Response = Response (Either String Compiled)
4347

4448
options :: P.Options
45-
options = P.defaultOptions { P.optionsTco = True }
49+
options = P.defaultOptions { P.optionsTco = True
50+
, P.optionsMagicDo = True
51+
, P.optionsModules = ["Main"] }
52+
53+
loadModule :: FilePath -> IO (Either String [P.Module])
54+
loadModule moduleFile = do
55+
moduleText <- readFile moduleFile
56+
return . either (Left . show) Right $ P.runIndentParser "" P.parseModules moduleText
4657

47-
compile :: String -> IO Response
48-
compile input | length input > 5000 = return $ Response $ Left "Please limit your input to 5000 characters"
49-
compile input = do
50-
case P.runIndentParser P.parseModules input of
58+
compile :: [P.Module] -> String -> IO Response
59+
compile _ input | length input > 5000 = return $ Response $ Left "Please limit your input to 5000 characters"
60+
compile prelude input = do
61+
case P.runIndentParser "" P.parseModules input of
5162
Left parseError -> do
5263
return $ Response $ Left $ show parseError
5364
Right modules -> do
54-
case P.compile options modules of
65+
case P.compile options (prelude ++ modules) of
5566
Left error ->
5667
return $ Response $ Left error
5768
Right (js, externs, _) ->
@@ -135,7 +146,9 @@ examples :: [(String, (String, String))]
135146
examples =
136147
[ ("adt",
137148
("Algebraic Data Types",
138-
unlines [ "module ADTs where"
149+
unlines [ "module Main where"
150+
, ""
151+
, "import Prelude"
139152
, ""
140153
, "data Person = Person { name :: String, age :: Number }"
141154
, ""
@@ -146,21 +159,25 @@ examples =
146159
]))
147160
, ("ops",
148161
("Operators",
149-
unlines [ "module Operators where"
162+
unlines [ "module Main where"
163+
, ""
164+
, "import Prelude"
150165
, ""
151-
, "infixl 5 |>"
166+
, "infixl 5 >>>"
152167
, ""
153-
, "(|>) :: forall a b c. (a -> b) -> (b -> c) -> a -> c"
154-
, "(|>) f g a = g (f a)"
168+
, "(>>>) :: forall a b c. (a -> b) -> (b -> c) -> a -> c"
169+
, "(>>>) f g a = g (f a)"
155170
, ""
156171
, "foreign import foo :: String -> Number"
157172
, "foreign import bar :: Number -> Boolean"
158173
, ""
159-
, "test = foo |> bar"
174+
, "test = foo >>> bar"
160175
]))
161176
, ("arrays",
162177
("Arrays",
163-
unlines [ "module Arrays where"
178+
unlines [ "module Main where"
179+
, ""
180+
, "import Prelude"
164181
, ""
165182
, "sum (x:xs) = x + sum xs"
166183
, "sum _ = 0"
@@ -170,13 +187,15 @@ examples =
170187
]))
171188
, ("rows",
172189
("Row Polymorphism",
173-
unlines [ "module RowPolymorphism where"
190+
unlines [ "module Main where"
191+
, ""
192+
, "import Prelude"
174193
, ""
175194
, "showPerson o = o.lastName ++ \", \" ++ o.firstName"
176195
]))
177196
, ("ffi",
178197
("FFI",
179-
unlines [ "module FFI where"
198+
unlines [ "module Main where"
180199
, ""
181200
, "foreign import data IO :: * -> *"
182201
, ""
@@ -186,7 +205,9 @@ examples =
186205
]))
187206
, ("blocks",
188207
("Mutable Variables",
189-
unlines [ "module Mutable where"
208+
unlines [ "module Main where"
209+
, ""
210+
, "import Prelude"
190211
, ""
191212
, "collatz :: Number -> Number"
192213
, "collatz n ="
@@ -207,17 +228,19 @@ examples =
207228
, ("modules",
208229
("Modules",
209230
unlines [ "module M1 where"
231+
, ""
232+
, "import Prelude"
210233
, ""
211234
, "incr :: Number -> Number"
212235
, "incr x = x + 1"
213236
, ""
214-
, "module M2 where"
237+
, "module Main where"
215238
, ""
216239
, "test = M1.incr 10"
217240
]))
218241
, ("rank2",
219242
("Rank N Types",
220-
unlines [ "module RankNTypes where"
243+
unlines [ "module Main where"
221244
, ""
222245
, "type Nat = forall a. a -> (a -> a) -> a"
223246
, ""
@@ -234,7 +257,9 @@ examples =
234257
]))
235258
, ("recursion",
236259
("Recursion",
237-
unlines [ "module Recursion where"
260+
unlines [ "module Main where"
261+
, ""
262+
, "import Prelude"
238263
, ""
239264
, "isOdd :: Number -> Boolean"
240265
, "isOdd 0 = false"
@@ -246,13 +271,7 @@ examples =
246271
]))
247272
, ("do",
248273
("Do Notation",
249-
unlines [ "module Prelude where"
250-
, ""
251-
, "class Monad m where"
252-
, " ret :: forall a. a -> m a"
253-
, " (>>=) :: forall a b. m a -> (a -> m b) -> m b"
254-
, ""
255-
, "module DoNotation where"
274+
unlines [ "module Main where"
256275
, ""
257276
, "import Prelude"
258277
, ""
@@ -275,7 +294,9 @@ examples =
275294
]))
276295
, ("tco",
277296
("Tail-Call Elimination",
278-
unlines [ "module TailCall where"
297+
unlines [ "module Main where"
298+
, ""
299+
, "import Prelude"
279300
, ""
280301
, "factHelper prod 0 = prod"
281302
, "factHelper prod n = factHelper (prod * n) (n - 1)"
@@ -284,7 +305,9 @@ examples =
284305
]))
285306
, ("typeclasses",
286307
("Type Classes",
287-
unlines [ "module TypeClasses where"
308+
unlines [ "module Main where"
309+
, ""
310+
, "import Prelude"
288311
, ""
289312
, "class Show a where"
290313
, " show :: a -> String"
@@ -365,20 +388,23 @@ responseToJs (Just (Response (Right (Compiled "" "")))) = (False, "Please enter
365388
responseToJs (Just (Response (Right (Compiled js _)))) = (True, js)
366389

367390
server :: Int -> IO ()
368-
server port = scotty port $ do
369-
get "/" $ do
370-
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
371-
get "/example/:name" $ do
372-
name <- param "name"
373-
case lookup name examples of
374-
Nothing -> raise "No such example"
375-
Just (_, code) -> do
376-
response <- lift $ compile code
377-
page (Just name) (Just code) (Just response)
378-
post "/compile" $ do
379-
code <- param "code"
380-
response <- lift $ compile code
381-
page Nothing (Just code) (Just response)
391+
server port = do
392+
preludeFilename <- getPreludeFilename
393+
Right prelude <- loadModule preludeFilename
394+
scotty port $ do
395+
get "/" $ do
396+
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
397+
get "/example/:name" $ do
398+
name <- param "name"
399+
case lookup name examples of
400+
Nothing -> raise "No such example"
401+
Just (_, code) -> do
402+
response <- lift $ compile prelude code
403+
page (Just name) (Just code) (Just response)
404+
post "/compile" $ do
405+
code <- param "code"
406+
response <- lift $ compile prelude code
407+
page Nothing (Just code) (Just response)
382408

383409
term :: Term (IO ())
384410
term = server <$> port

0 commit comments

Comments
 (0)