Skip to content

Commit e6e5099

Browse files
paf31paf31
committed
Updates for 0.6.9.3
1 parent bf7ed0c commit e6e5099

18 files changed

+247
-437
lines changed

‎Main.hs

Lines changed: 63 additions & 93 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
-----------------------------------------------------------------------------
22
--
33
-- Module : Main
4-
-- Copyright : (c) Phil Freeman 2013
4+
-- Copyright : (c) Phil Freeman 2013-2015
55
-- License : MIT
66
--
77
-- Maintainer : [email protected]
@@ -18,40 +18,40 @@ module Main (
1818
main
1919
) where
2020

21-
import Web.Scotty
22-
import qualified Web.Scotty as Scotty
2321
import qualified Language.PureScript as P
2422

2523
import Data.Version (showVersion)
26-
27-
import Network.HTTP.Types (status500)
28-
2924
import Data.Monoid
3025
import Data.String
3126
import Data.Maybe (mapMaybe)
3227
import Data.List (intercalate)
33-
import System.Console.CmdTheLine
28+
import Data.FileEmbed
29+
30+
import qualified Data.ByteString as B
31+
import qualified Data.ByteString.Char8 as BC8
32+
import qualified Data.ByteString.Lazy.Char8 as BLC8
33+
34+
import qualified Data.Map as M
35+
3436
import Control.Applicative
3537
import Control.Monad (when, forM_)
3638
import Control.Monad.Trans
37-
import qualified Data.Map as M
39+
import Control.Monad.Reader
40+
41+
import Network.HTTP.Types (status500)
42+
43+
import Web.Scotty
44+
import qualified Web.Scotty as Scotty
45+
3846
import Text.Blaze.Html
3947
import Text.Blaze.Internal
4048
import Text.Blaze.Html.Renderer.Text
4149
import qualified Text.Blaze.Html5 as H
4250
import qualified Text.Blaze.Html5.Attributes as A
43-
import qualified System.IO.UTF8 as U
4451

4552
import qualified Paths_trypurescript as Paths
4653

47-
import qualified Data.ByteString as B
48-
import qualified Data.ByteString.UTF8 as BU
49-
import qualified Data.ByteString.Lazy.UTF8 as BUL
50-
51-
import Data.FileEmbed
52-
53-
prelude :: String
54-
prelude = BU.toString $(embedFile "prelude/prelude.purs")
54+
import System.Environment (getArgs)
5555

5656
data Compiled = Compiled { js :: String
5757
, externs :: String
@@ -60,16 +60,19 @@ data Compiled = Compiled { js :: String
6060
newtype Response = Response { runResponse :: Either String Compiled }
6161

6262
options :: P.Options P.Compile
63-
options = P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "PS" ["Main"] [] }
63+
options = P.defaultCompileOptions
64+
{ P.optionsAdditional = P.CompileOptions "PS" [] []
65+
, P.optionsMain = Just "Main"
66+
}
6467

6568
compile :: [P.Module] -> String -> IO Response
66-
compile _ input | length input > 5000 = return $ Response $ Left "Please limit your input to 5000 characters"
69+
compile _ input | length input > 20000 = return $ Response $ Left "Please limit your input to 20000 characters"
6770
compile prelude input = do
68-
case P.runIndentParser "" P.parseModules input of
71+
case either Left (Right . map snd) $ P.parseModulesFromFiles (const "<file>") [(undefined, input)] of
6972
Left parseError -> do
7073
return $ Response $ Left $ show parseError
7174
Right modules -> do
72-
case P.compile options (prelude ++ modules) [] of
75+
case flip runReaderT options $ P.compile (prelude ++ modules) ["Generated by trypurescript"] of
7376
Left error ->
7477
return $ Response $ Left error
7578
Right (js, externs, _) ->
@@ -82,42 +85,39 @@ mono :: H.Html -> H.Html
8285
mono h = h ! A.class_ "mono"
8386

8487
css :: String
85-
css = BU.toString $(embedFile "assets/style.css")
88+
css = BC8.unpack $(embedFile "assets/style.css")
8689

8790
gaq :: String
88-
gaq = BU.toString $(embedFile "assets/gaq.js")
91+
gaq = BC8.unpack $(embedFile "assets/gaq.js")
8992

90-
ace :: String
91-
ace = BU.toString $(embedFile "assets/ace.js")
93+
scripts :: String
94+
scripts = BC8.unpack $(embedFile "assets/scripts.js")
9295

9396
defaultCode :: String
94-
defaultCode = BU.toString $(embedFile "examples/default.purs")
97+
defaultCode = BC8.unpack $(embedFile "examples/default.purs")
9598

9699
examples :: [(String, (String, String))]
97100
examples =
98-
[ ("adt", ("Algebraic Data Types", BU.toString $(embedFile "examples/adt.purs")))
99-
, ("ops", ("Operators", BU.toString $(embedFile "examples/operators.purs")))
100-
, ("arrays", ("Arrays", BU.toString $(embedFile "examples/arrays.purs")))
101-
, ("rows", ("Row Polymorphism", BU.toString $(embedFile "examples/rows.purs")))
102-
, ("ffi", ("FFI", BU.toString $(embedFile "examples/ffi.purs")))
103-
, ("mutable", ("Mutable Variables", BU.toString $(embedFile "examples/mutable.purs")))
104-
, ("modules", ("Modules", BU.toString $(embedFile "examples/modules.purs")))
105-
, ("rank2", ("Rank N Types", BU.toString $(embedFile "examples/rankn.purs")))
106-
, ("recursion", ("Recursion", BU.toString $(embedFile "examples/recursion.purs")))
107-
, ("do", ("Do Notation", BU.toString $(embedFile "examples/do.purs")))
108-
, ("tco", ("Tail-Call Elimination", BU.toString $(embedFile "examples/tco.purs")))
109-
, ("typeclasses", ("Type Classes", BU.toString $(embedFile "examples/typeclasses.purs")))
101+
[ ("adt", ("Algebraic Data Types", BC8.unpack $(embedFile "examples/adt.purs")))
102+
, ("ops", ("Operators", BC8.unpack $(embedFile "examples/operators.purs")))
103+
, ("arrays", ("Arrays", BC8.unpack $(embedFile "examples/arrays.purs")))
104+
, ("rows", ("Row Polymorphism", BC8.unpack $(embedFile "examples/rows.purs")))
105+
, ("ffi", ("FFI", BC8.unpack $(embedFile "examples/ffi.purs")))
106+
, ("mutable", ("Mutable Variables", BC8.unpack $(embedFile "examples/mutable.purs")))
107+
, ("recursion", ("Recursion", BC8.unpack $(embedFile "examples/recursion.purs")))
108+
, ("do", ("Do Notation", BC8.unpack $(embedFile "examples/do.purs")))
109+
, ("tco", ("Tail-Call Elimination", BC8.unpack $(embedFile "examples/tco.purs")))
110+
, ("typeclasses", ("Type Classes", BC8.unpack $(embedFile "examples/typeclasses.purs")))
110111
]
111112

112-
page :: Maybe String -> Maybe String -> Maybe Response -> ActionM ()
113-
page ex input res = html $ renderHtml $ do
113+
page :: String -> ActionM ()
114+
page input = html $ renderHtml $ do
114115
H.docType
115116
H.html $ do
116117
H.head $ do
117118
H.title $ H.toHtml $ str "Try PureScript!"
118119
H.meta ! A.name "viewport" ! A.content "width=device-width, initial-scale=1.0"
119-
H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "http://fonts.googleapis.com/css?family=PT+Serif:400,700"
120-
H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "http://fonts.googleapis.com/css?family=Ubuntu+Mono"
120+
H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "http://fonts.googleapis.com/css?family=Roboto:300,600"
121121
H.style $ H.toHtml $ str css
122122
H.script ! A.type_ "text/javascript" $ preEscapedToHtml gaq
123123
H.script ! A.type_ "text/javascript" ! A.src "//cdnjs.cloudflare.com/ajax/libs/jquery/1.10.2/jquery.js" $ mempty
@@ -132,52 +132,36 @@ page ex input res = html $ renderHtml $ do
132132
! customAttribute "data-canonical-src" "https://s3.amazonaws.com/github/ribbons/forkme_right_red_aa0000.png"
133133
H.div ! A.class_ "wrapper" $ do
134134
H.div ! A.class_ "header" $ do
135-
H.h1 $ H.toHtml $ str "Try PureScript!"
135+
H.h1 $ H.toHtml $ str "Try PureScript!"
136136
H.div ! A.class_ "body" $ do
137-
H.p $ H.toHtml $ str "Type PureScript code below and press 'Compile', or select one of the examples below:"
138-
139-
H.h2 $ H.toHtml $ str "Examples"
140-
H.ul $ do
141-
forM_ examples $ \(name, (title, _)) ->
142-
H.li $ H.a ! A.href (fromString $ "/example/" ++ name) $ H.toHtml title
143-
144-
let (success, text) = responseToJs res
145-
146-
H.h2 $ H.toHtml $ str "PureScript Code"
147-
H.form ! A.action "/compile/html" ! A.method "POST" $ do
148-
H.div ! A.id "code" $ mempty
149-
H.textarea ! A.name "code" ! A.id "textarea" ! A.style "display: none;" $ maybe mempty (H.toHtml . str) input
150-
H.div $ H.button ! A.type_ "submit" $ H.toHtml $ str "Compile"
151-
H.script ! A.type_ "text/javascript" $ preEscapedToHtml ace
152-
153-
H.h2 $ H.toHtml $ str "Generated Javascript"
154-
H.pre $ H.code $ H.toHtml . str $ text
155-
156-
responseToJs :: Maybe Response -> (Bool, String)
157-
responseToJs Nothing = (False, "")
158-
responseToJs (Just (Response (Left err))) = (False, err)
159-
responseToJs (Just (Response (Right (Compiled "" "")))) = (False, "Please enter some input")
160-
responseToJs (Just (Response (Right (Compiled js _)))) = (True, js)
137+
H.p $ H.toHtml $ str "Type PureScript code below and press 'Compile', or select one of the examples below:"
138+
139+
H.h2 $ H.toHtml $ str "Examples"
140+
H.ul $ do
141+
forM_ examples $ \(name, (title, _)) ->
142+
H.li $ H.a ! A.href (fromString $ "/example/" ++ name) $ H.toHtml title
143+
144+
H.h2 $ H.toHtml $ str "PureScript Code"
145+
H.div ! A.id "code" $ mempty
146+
H.textarea ! A.name "code" ! A.id "textarea" ! A.style "display: none;" $ H.toHtml $ str input
147+
H.p $ H.button ! A.id "compile" $ H.toHtml $ str "Compile and Run"
148+
H.script ! A.type_ "text/javascript" $ preEscapedToHtml scripts
149+
H.div ! A.id "results" $ mempty
161150

162151
server :: Int -> IO ()
163152
server port = do
164-
let preludeModules = either (error . show) id $ P.runIndentParser "" P.parseModules prelude
153+
let preludeModules = either (error . show) (map snd) $ P.parseModulesFromFiles (const "<prelude>") [(undefined, P.prelude)]
165154
scotty port $ do
166155
get "/" $ do
167-
page Nothing (Just defaultCode) Nothing
156+
page defaultCode
168157
get "/example/:name" $ do
169158
name <- param "name"
170159
case lookup name examples of
171160
Nothing -> raise "No such example"
172161
Just (_, code) -> do
173-
response <- lift $ compile preludeModules code
174-
page (Just name) (Just code) (Just response)
175-
post "/compile/html" $ do
176-
code <- param "code"
177-
response <- lift $ compile preludeModules code
178-
page Nothing (Just code) (Just response)
162+
page code
179163
post "/compile/text" $ do
180-
code <- BUL.toString <$> body
164+
code <- BLC8.unpack <$> body
181165
response <- lift $ compile preludeModules code
182166
case runResponse response of
183167
Left err -> do
@@ -186,21 +170,7 @@ server port = do
186170
Right comp ->
187171
Scotty.text . fromString $ js comp
188172

189-
term :: Term (IO ())
190-
term = server <$> port
191-
192-
port :: Term Int
193-
port = value $ opt 80 $ (optInfo [ "p", "port" ])
194-
{ optDoc = "The port to listen on" }
195-
196-
termInfo :: TermInfo
197-
termInfo = defTI
198-
{ termName = "trypurescript"
199-
, version = showVersion Paths.version
200-
, termDoc = "Try PureScript in the browser"
201-
}
202-
203173
main :: IO ()
204-
main = run (term, termInfo)
205-
206-
174+
main = do
175+
[port] <- getArgs
176+
server (read port)

‎assets/ace.js

Lines changed: 0 additions & 15 deletions
This file was deleted.

‎assets/scripts.js

Lines changed: 82 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,82 @@
1+
$(function() {
2+
3+
var editor = ace.edit('code');
4+
5+
editor.setTheme('ace/theme/dawn');
6+
editor.renderer.setShowGutter(false);
7+
8+
var session = editor.getSession();
9+
10+
session.setMode('ace/mode/haskell');
11+
session.setValue($('#textarea').val());
12+
session.setUseWrapMode(true);
13+
session.on('change', function(){
14+
$('#textarea').val(editor.getSession().getValue());
15+
});
16+
17+
$('#code').height('250px');
18+
19+
$('#compile').click(function() {
20+
21+
var code = $('#textarea').val();
22+
23+
$.ajax({
24+
url: '/compile/text',
25+
dataType: 'text',
26+
data: code,
27+
method: 'POST',
28+
success: function(res) {
29+
var $iframe = $('<iframe>');
30+
31+
$('#results').empty()
32+
.append($('<h2>').append('Compiled Result'))
33+
.append($iframe);
34+
35+
$('html, body').animate({
36+
scrollTop: $iframe.offset().top
37+
}, 500);
38+
39+
var iframe = $iframe.get(0).contentWindow.document;
40+
41+
iframe.open();
42+
iframe.write(
43+
[ '<html>'
44+
, ' <head>'
45+
, ' <title>Try PureScript</title>'
46+
, ' </head>'
47+
, ' <body>'
48+
, ' <div id="console"></div>'
49+
, ' </body>'
50+
, '</html>'
51+
].join('\n'));
52+
53+
var initScript =
54+
[ 'var console = {'
55+
, ' log: function(s) {'
56+
, ' var text = document.createTextNode(s);'
57+
, ' var code = document.createElement("code");'
58+
, ' var div = document.createElement("div");'
59+
, ' div.appendChild(code);'
60+
, ' code.appendChild(text);'
61+
, ' document.getElementById("console").appendChild(div);'
62+
, ' }'
63+
, '};'
64+
].join('\n');
65+
66+
var scripts = [initScript, res];
67+
68+
for (var i = 0; i < scripts.length; i++) {
69+
var script = iframe.createElement('script');
70+
script.appendChild(iframe.createTextNode(scripts[i]));
71+
var head = iframe.getElementsByTagName('head')[0];
72+
head.appendChild(script);
73+
}
74+
},
75+
error: function(res) {
76+
$('#results').empty()
77+
.append($('<h2>').append('Error'))
78+
.append($('<pre>').append($('<code>').append(res.responseText)));
79+
}
80+
});
81+
});
82+
});

‎assets/style.css

Lines changed: 14 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@
2020

2121
body
2222
{
23-
font: 18px "PT Serif", Georgia, Times, Serif;
23+
font: 18px Roboto, sans-serif;
2424
line-height: 150%;
2525
color: #404040;
2626
margin: 0;
@@ -74,19 +74,21 @@ a {
7474
}
7575

7676
button {
77-
background: #d0d0d0;
78-
color: #606060;
79-
padding-top: 3px;
80-
padding-bottom: 3px;
81-
font-weight: bold;
82-
border-radius: 1px;
83-
border: 1px solid #c0c0c0;
84-
box-shadow: 1px 1px 0 0 #ffffff inset;
85-
padding-left: 15px;
86-
padding-right: 15px;
77+
background: #800000;
78+
color: #ffffff;
79+
padding: 10px 15px;
80+
font-size: 12px;
81+
border: 0;
82+
box-shadow: 2px 2px 4px #BBAAAA;
8783
cursor: pointer;
8884
}
8985

9086
button:hover {
91-
background: #e0e0e0;
87+
background: #9B4242;
9288
}
89+
90+
iframe {
91+
width: 100%;
92+
border: 1px solid #f0f0f0;
93+
box-shadow: 0 0 10px #F6F6F6;
94+
}

0 commit comments

Comments
 (0)