Skip to content

Commit 33b20b2

Browse files
paf31paf31
committed
New theme
1 parent 0b60d08 commit 33b20b2

File tree

1 file changed

+86
-38
lines changed

1 file changed

+86
-38
lines changed

‎Main.hs

Lines changed: 86 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -60,22 +60,27 @@ str = id
6060
mono :: H.Html -> H.Html
6161
mono h = h ! A.class_ "mono"
6262

63+
examplesJs :: String
64+
examplesJs = unlines
65+
[ "$('#examples').change(function() {"
66+
, " var name = $('#examples').val();"
67+
, " if (name) {"
68+
, " window.location = '/example/' + name;"
69+
, " }"
70+
, "});"
71+
]
72+
6373
css :: String
6474
css = unlines
6575
[ "body { font-family: 'Lato', sans-serif; color: #404040; margin: 0; }"
66-
, ".mono { font-family: 'Ubuntu Mono', monospace; white-space: pre }"
76+
, ".mono { font-family: 'Ubuntu Mono', monospace; white-space: pre; word-break: break-all; word-wrap: break-word; }"
6777
, ".header { margin: 0; background: #202028; box-shadow: 0 0 10px #808080; color: #E0E0E0; }"
6878
, ".splitter { margin: 0; height: 5px; background: #606068; }"
69-
, ".center { width: 960px; margin: 0 auto; padding: 20px; }"
79+
, ".center { margin: 0 auto; padding: 20px; }"
7080
, "a { color: #808080; }"
71-
, "@media (max-width:1000px) { .center { width: auto; } }"
72-
, "ul.examples { list-style-type: none; margin-left: 0; padding-left: 0; }"
73-
, "ul.examples li { float: left; padding-top: 5px; padding-bottom: 5px; margin-right: 2px; }"
74-
, "ul.examples li a { background: #d0d0d0; color: #606060; padding-top: 3px; padding-bottom: 3px; font-weight: bold; border-radius: 1px; border: 1px solid #c0c0c0; box-shadow: 1px 1px 0 0 #ffffff inset; text-decoration: none; padding-left: 15px; padding-right: 15px; }"
75-
, "ul.examples li a:hover { background: #e0e0e0; }"
7681
, "button { background: #d0d0d0; color: #606060; padding-top: 3px; padding-bottom: 3px; font-weight: bold; border-radius: 1px; border: 1px solid #c0c0c0; box-shadow: 1px 1px 0 0 #ffffff inset; padding-left: 15px; padding-right: 15px; cursor: pointer; }"
7782
, "button:hover { background: #e0e0e0; }"
78-
]
83+
, "#code, #js { margin: 10px; }"]
7984

8085
gaq :: String
8186
gaq = unlines
@@ -88,6 +93,41 @@ gaq = unlines
8893
, " var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);"
8994
, "})();" ]
9095

96+
ace :: Bool -> String
97+
ace js = unlines $
98+
[ "var editor = ace.edit('code');"
99+
, "editor.setTheme('ace/theme/dawn');"
100+
, "editor.renderer.setShowGutter(false);"
101+
, "var session = editor.getSession();"
102+
, "session.setMode('ace/mode/haskell');"
103+
, "session.setValue($('#textarea').val());"
104+
, "session.setUseWrapMode(true);"
105+
, "session.on('change', function(){"
106+
, " $('#textarea').val(editor.getSession().getValue());"
107+
, "});"
108+
, "if ($('#js')[0]) {"
109+
, " var js = ace.edit('js');"
110+
, " js.setTheme('ace/theme/dawn');"
111+
, " js.renderer.setShowGutter(false);"
112+
, " js.setReadOnly(true);"
113+
, " var session = js.getSession();"
114+
, " session.setUseWrapMode(true);"
115+
]
116+
++ (if js then
117+
[ " session.setMode('ace/mode/javascript');" ]
118+
else
119+
[]) ++
120+
[ "}"
121+
, "function setHeight() {"
122+
, " var top = $('#code').offset().top;"
123+
, " var tot = $(window).height();"
124+
, " var height = Math.max(tot - top - 50, 200);"
125+
, " $('#code').height(height + 'px');"
126+
, " $('#js').height(height + 'px');"
127+
, "}"
128+
, "$(setHeight);"
129+
, "$(window).on('resize', setHeight);" ]
130+
91131
examples :: [(String, (String, String))]
92132
examples =
93133
[ ("adt",
@@ -120,9 +160,9 @@ examples =
120160
unlines [ "module Arrays where"
121161
, ""
122162
, "sum (x:xs) = x + sum xs"
123-
, "sum [] = 0"
163+
, "sum _ = 0"
124164
, ""
125-
, "sumOfProducts (x : y : xs) = x * y + sum xs"
165+
, "sumOfProducts (x : y : xs) = x * y + sumOfProducts xs"
126166
, "sumOfProducts _ = 0"
127167
]))
128168
, ("rows",
@@ -224,8 +264,8 @@ examples =
224264
]))
225265
]
226266

227-
page :: Maybe String -> Maybe Response -> ActionM ()
228-
page input res = html $ renderHtml $ do
267+
page :: Maybe String -> Maybe String -> Maybe Response -> ActionM ()
268+
page ex input res = html $ renderHtml $ do
229269
H.docType
230270
H.html $ do
231271
H.head $ do
@@ -235,6 +275,10 @@ page input res = html $ renderHtml $ do
235275
H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "http://fonts.googleapis.com/css?family=Ubuntu+Mono"
236276
H.style $ H.toHtml $ str css
237277
H.script ! A.type_ "text/javascript" $ preEscapedToHtml gaq
278+
H.script ! A.type_ "text/javascript" ! A.src "//cdnjs.cloudflare.com/ajax/libs/jquery/1.10.2/jquery.js" $ mempty
279+
H.script ! A.type_ "text/javascript" ! A.src "//cdnjs.cloudflare.com/ajax/libs/ace/1.1.01/ace.js" ! A.charset "utf-8" $ mempty
280+
H.script ! A.type_ "text/javascript" ! A.src "//cdnjs.cloudflare.com/ajax/libs/ace/1.1.01/mode-haskell.js" $ mempty
281+
H.script ! A.type_ "text/javascript" ! A.src "//cdnjs.cloudflare.com/ajax/libs/ace/1.1.01/theme-dawn.js" $ mempty
238282
H.body $ do
239283
H.div ! A.class_ "header" $ do
240284
H.div ! A.class_ "center" $ do
@@ -248,45 +292,49 @@ page input res = html $ renderHtml $ do
248292
H.div ! A.class_ "splitter" $ mempty
249293
H.div ! A.class_ "main" $ do
250294
H.div ! A.class_ "center" $ do
251-
H.h2 $ H.toHtml $ str "Examples"
252-
H.ul ! A.class_ "examples" $ forM_ examples $ \(name, (title, _)) -> do
253-
H.li $ H.a ! A.href (fromString $ "/example/" ++ name) $ H.toHtml title
254-
H.div ! A.style "clear: left;" $ mempty
255-
H.h2 $ H.toHtml $ str "PureScript Code"
256-
H.form ! A.action "/compile" ! A.method "POST" $ do
257-
H.textarea ! A.name "code" ! A.rows "15" ! A.style "width: 100%" $ maybe mempty (H.toHtml . str) input
258-
H.div $ H.button ! A.type_ "submit" $ H.toHtml $ str "Compile"
259-
case res of
260-
Nothing -> mempty
261-
Just (Response (Left err)) -> do
262-
H.h1 $ H.toHtml $ str "Error!"
263-
mono $ H.p $ H.toHtml $ err
264-
Just (Response (Right (Compiled "" ""))) -> do
265-
H.h1 $ H.toHtml $ str "Error!"
266-
mono $ H.p $ H.toHtml $ str "Please enter some input"
267-
Just (Response (Right (Compiled js exts))) -> do
268-
when (not . null $ js) $ do
269-
H.h1 $ H.toHtml $ str "Generated Javascript"
270-
mono $ H.p $ H.toHtml js
271-
when (not . null $ exts) $ do
272-
H.h1 $ H.toHtml $ str "Externs"
273-
mono $ H.p $ H.toHtml exts
295+
let (success, text) = responseToJs res
296+
H.div $ do
297+
H.select ! A.style "float: right;" ! A.id "examples" $ do
298+
H.option ! A.value "" $ "Examples"
299+
H.option ! A.value "" $ ""
300+
forM_ examples $ \(name, (title, _)) -> case () of
301+
_ | ex == Just name -> H.option ! A.value (fromString name) ! A.selected "selected" $ H.toHtml title
302+
_ -> H.option ! A.value (fromString name) $ H.toHtml title
303+
H.script ! A.type_ "text/javascript" $ preEscapedToHtml examplesJs
304+
H.div ! A.style "clear: right;" $ mempty
305+
H.div ! A.style "position: relative; "$ do
306+
H.div ! A.style "position: absolute; width: 50%;" $ do
307+
H.h2 $ H.toHtml $ str "PureScript Code"
308+
H.form ! A.action "/compile" ! A.method "POST" $ do
309+
H.div ! A.id "code" $ mempty
310+
H.textarea ! A.name "code" ! A.id "textarea" ! A.style "display: none;" $ maybe mempty (H.toHtml . str) input
311+
H.div $ H.button ! A.type_ "submit" $ H.toHtml $ str "Compile"
312+
H.div ! A.style "position: absolute; width: 50%; left: 50%;" $ do
313+
H.h2 $ H.toHtml $ str "Generated Javascript"
314+
H.div ! A.id "js" $ H.toHtml . str $ text
315+
H.script ! A.type_ "text/javascript" $ preEscapedToHtml (ace success)
316+
317+
responseToJs :: Maybe Response -> (Bool, String)
318+
responseToJs Nothing = (False, "")
319+
responseToJs (Just (Response (Left err))) = (False, err)
320+
responseToJs (Just (Response (Right (Compiled "" "")))) = (False, "Please enter some input")
321+
responseToJs (Just (Response (Right (Compiled js _)))) = (True, js)
274322

275323
server :: Int -> IO ()
276324
server port = scotty port $ do
277325
get "/" $ do
278-
page Nothing Nothing
326+
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
279327
get "/example/:name" $ do
280328
name <- param "name"
281329
case lookup name examples of
282330
Nothing -> raise "No such example"
283331
Just (_, code) -> do
284332
response <- lift $ compile code
285-
page (Just code) (Just response)
333+
page (Just name) (Just code) (Just response)
286334
post "/compile" $ do
287335
code <- param "code"
288336
response <- lift $ compile code
289-
page (Just code) (Just response)
337+
page Nothing (Just code) (Just response)
290338

291339
term :: Term (IO ())
292340
term = server <$> port

0 commit comments

Comments
 (0)