elm-reactor (empty) → 0.1
raw patch · 21 files changed
+1857/−0 lines, 21 filesdep +Elmdep +HTTPdep +basesetup-changedbinary-added
Dependencies added: Elm, HTTP, base, blaze-html, blaze-markup, bytestring, cmdargs, containers, directory, filepath, fsnotify, mtl, process, snap-core, snap-server, system-filepath, time, transformers, unordered-containers, websockets, websockets-snap
Files
- LICENSE +30/−0
- README.md +79/−0
- Setup.hs +71/−0
- assets/_reactor/debugger/pause-button-down.png binary
- assets/_reactor/debugger/pause-button-hover.png binary
- assets/_reactor/debugger/pause-button-up.png binary
- assets/_reactor/debugger/play-button-down.png binary
- assets/_reactor/debugger/play-button-hover.png binary
- assets/_reactor/debugger/play-button-up.png binary
- assets/_reactor/debugger/restart-button-down.png binary
- assets/_reactor/debugger/restart-button-hover.png binary
- assets/_reactor/debugger/restart-button-up.png binary
- assets/_reactor/wrench.png binary
- assets/debugger.js +1050/−0
- assets/favicon.ico binary
- elm-reactor.cabal +72/−0
- server/Generate.hs +107/−0
- server/Index.hs +201/−0
- server/Server.hs +152/−0
- server/Socket.hs +57/−0
- server/Utils.hs +38/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012-2014, Evan Czaplicki++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Evan Czaplicki nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,79 @@+# Elm Reactor++Interactive development tool that makes it easy to develop and debug Elm+programs. Key features include:++ * Automatically compile any Elm program+ * [Hot-swapping][]+ * [Time travel debugging][debug]+ * Compatible with any editor++[hot-swapping]: http://elm-lang.org/blog/Interactive-Programming.elm+[debug]: http://debug.elm-lang.org++This means you can get a great development experience whether you are using+Sublime Text, emacs, vim, or whatever else to edit Elm code.++## Install++Install [Elm Platform][platform]. This will install Elm Reactor and everything+else it needs.++[platform]: https://github.com/elm-lang/elm-platform++## Use++Navigate to the Elm project you want to work on. A great project to get started+with is [elm-examples][] which contains a simple Mario game and todo list app,+both setup to be fun to debug.++[elm-examples]: https://github.com/michaelbjames/elm-examples++In the root of your Elm project start the reactor with:++```bash+elm-reactor+```++Now open [http://localhost:8000](http://localhost:8000) in your browser. You+should see a navigation page for your project.++Click on any file to see what it looks like. For example, you can navigate to+an Elm file and try it out. If you modify the file, you can just refresh that+page and see the new version!++#### Time Travel Debugging++To use the debugger, click the small wrench next to every Elm file. This will+start your Elm program with a control panel that lets you:++ * Pause, rewind, and continue from any point.++ * Add watches and traces to track and visualize values over time.++ * Hot-swap in new code at any time, maintaining all recorded events.+++#### Debugging code embedded in HTML++To use the debugger with more complex HTML or CSS, you may want to start the+debugger from within an HTML file.++In your custom HTML file load the `/debugger.js` script right after you load+elm-runtime:++```html+<script type="text/javascript" src="/elm-runtime.js"></script>+<script type="text/javascript" src="/debugger.js"></script>+```++That creates the `Elm.debugFullscreen` function so you can initiate your Elm+program with the debugger:++```javascript+var runningElmModule = Elm.debugFullscreen(Elm.Todo, "todo.elm");+```++The argument `"todo.elm"` is the file path to the root module of your project,+the one with a `main` value. This file path makes it possible to hot-swap when+you change any relevant code.
+ Setup.hs view
@@ -0,0 +1,71 @@+import Distribution.Simple+import Distribution.Simple.Setup+import Distribution.Simple.LocalBuildInfo+import Distribution.PackageDescription++import System.IO+import System.Exit+import System.Process+import Control.Monad+import System.FilePath+import System.Directory+++main :: IO ()+main = defaultMainWithHooks simpleUserHooks { postBuild = myPostBuild }++myPostBuild :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()+myPostBuild args flags pd lbi =+ do putStrLn "Custom build step: compiling debuggerInterface.elm"+ buildInterface lbi+ concatJS lbi+ postBuild simpleUserHooks args flags pd lbi++concatJS :: LocalBuildInfo -> IO ()+concatJS lbi =+ do let files = map (("assets" </> "_reactor") </>)+ [ "debuggerInterface.js"+ , "toString.js"+ , "core.js"+ , "reactor.js"+ ]+ megaJS <- concat `fmap` mapM readFile files+ _ <- putStrLn "Writing composite debugger.js"+ writeFile ("assets" </> "debugger.js") megaJS++buildInterface :: LocalBuildInfo -> IO ()+buildInterface lbi =+ do exitCode <- compile $ args "debuggerInterface.elm"+ case exitCode of+ ExitFailure _ ->+ putStrLn "Build failed: debuggerInterface"+ ExitSuccess ->+ renameFile+ ("slider" </> "build" </> "debuggerInterface.js")+ ("assets" </> "_reactor" </> "debuggerInterface.js")++ removeEverything "slider" "Slider.elm"+ removeEverything "slider" "debuggerInterface.elm"+ where+ args file =+ [ "--make"+ , "--only-js"+ , file+ ]++ compile args =+ do let workingDir = Just "slider"+ handle <- runProcess "elm" args workingDir Nothing Nothing Nothing Nothing+ exitCode <- waitForProcess handle+ return exitCode++ removeEverything dir file =+ do remove "cache" "elmi"+ remove "cache" "elmo"+ remove "build" "js"+ where+ remove :: String -> String -> IO ()+ remove subdir ext =+ do let path = dir </> subdir </> file`replaceExtension` ext+ exists <- doesFileExist path+ when exists (removeFile path)
+ assets/_reactor/debugger/pause-button-down.png view
binary file changed (absent → 824 bytes)
+ assets/_reactor/debugger/pause-button-hover.png view
binary file changed (absent → 777 bytes)
+ assets/_reactor/debugger/pause-button-up.png view
binary file changed (absent → 765 bytes)
+ assets/_reactor/debugger/play-button-down.png view
binary file changed (absent → 855 bytes)
+ assets/_reactor/debugger/play-button-hover.png view
binary file changed (absent → 844 bytes)
+ assets/_reactor/debugger/play-button-up.png view
binary file changed (absent → 827 bytes)
+ assets/_reactor/debugger/restart-button-down.png view
binary file changed (absent → 921 bytes)
+ assets/_reactor/debugger/restart-button-hover.png view
binary file changed (absent → 920 bytes)
+ assets/_reactor/debugger/restart-button-up.png view
binary file changed (absent → 903 bytes)
+ assets/_reactor/wrench.png view
binary file changed (absent → 3007 bytes)
+ assets/debugger.js view
@@ -0,0 +1,1050 @@+Elm.Native.Slider = {};+Elm.Native.Slider.make = function(elm) {++ elm.Native = elm.Native || {};+ elm.Native.Slider = elm.Native.Slider || {};+ if (elm.Native.Slider.values) return elm.Native.Slider.values;++ var newNode = ElmRuntime.use(ElmRuntime.Render.Utils).newElement;+ var newElement = Elm.Graphics.Element.make(elm).newElement;++ function renderSlider(model) {+ var node = newNode('input');+ node.type = 'range';++ node.min = model.styling.min;+ node.max = model.styling.max;+ node.step = model.styling.step;+ node.value = model.styling.value;++ if (!model.styling.horizontal) {+ node.orient = "vertical"; // FF+ node.style.webkitAppearance = "slider-vertical"; // webkit+ node.style.writingMode = "bt-lr"; // ie+ }++ if (model.styling.disabled) {+ node.disabled = true;+ }++ node.style.display = 'block';+ node.style.pointerEvents = 'auto';+ node.elm_signal = model.signal;+ node.elm_handler = model.handler;+ node.addEventListener('input', notifySlider);+ node.addEventListener('change', notifySlider);+ function notifySlider() {+ elm.notify(node.elm_signal.id, node.elm_handler(node.value));+ }+ return node;+ }++ function updateSlider(node, oldModel, newModel) {+ if (newModel.styling.disabled) {+ node.disabled = true;+ } else {+ node.disabled = false;+ }+ node.elm_signal = newModel.signal;+ node.elm_handler = newModel.handler;+ node.min = newModel.styling.min;+ node.max = newModel.styling.max;+ node.step = newModel.styling.step;+ node.value = newModel.styling.value;+ }++ function slider(signal, handler, styling) {+ var width = styling.length;+ var height = 24;+ if (!styling.horizontal) {+ var temp = width;+ width = height;+ height = temp;+ }+ return A3(newElement, width, height, {+ ctor: 'Custom',+ type: 'Slider',+ render: renderSlider,+ update: updateSlider,+ model: { signal:signal, handler:handler, styling:styling }+ });+ }++ return elm.Native.Slider.values = {+ slider:F3(slider)+ };+}+Elm.DebuggerInterface = Elm.DebuggerInterface || {};+Elm.DebuggerInterface.make = function (_elm) {+ "use strict";+ _elm.DebuggerInterface = _elm.DebuggerInterface || {};+ if (_elm.DebuggerInterface.values)+ return _elm.DebuggerInterface.values;+ var _op = {},+ _N = Elm.Native,+ _U = _N.Utils.make(_elm),+ _L = _N.List.make(_elm),+ _A = _N.Array.make(_elm),+ _E = _N.Error.make(_elm),+ $moduleName = "DebuggerInterface",+ $Basics = Elm.Basics.make(_elm),+ $Color = Elm.Color.make(_elm),+ $Graphics$Collage = Elm.Graphics.Collage.make(_elm),+ $Graphics$Element = Elm.Graphics.Element.make(_elm),+ $Graphics$Input = Elm.Graphics.Input.make(_elm),+ $List = Elm.List.make(_elm),+ $Maybe = Elm.Maybe.make(_elm),+ $Native$Json = Elm.Native.Json.make(_elm),+ $Native$Ports = Elm.Native.Ports.make(_elm),+ $Signal = Elm.Signal.make(_elm),+ $Slider = Elm.Slider.make(_elm),+ $String = Elm.String.make(_elm),+ $Text = Elm.Text.make(_elm),+ $Window = Elm.Window.make(_elm);+ var noWatches = $Text.markdown("<div style=\"height:0;width:0;\"> </div><h3><span style=\"font-family: Gotham, Futura, \'Lucida Grande\', sans-serif; font-size: 12pt; color: rgb(170,170,170)\"> You don't have any watches! </span></h3>\n<p><span style=\"color: rgb(170,170,170)\">\n<span style=\"font-family: Gotham, Futura, \'Lucida Grande\', sans-serif; font-size: 10pt; color: rgb(170,170,170)\">\nUse <a href=\"http://library.elm-lang.org/catalog/elm-lang-Elm/latest/Debug#watch\"><span style=\"text-decoration:underline; color: rgb(170,170,170)\">Debug.watch</span></a>\nto show any value. <br>\n<code>watch : String -> a -> a</code></span></p>\n<p><span style=\"font-family: Gotham, Futura, \'Lucida Grande\', sans-serif; font-size: 10pt; color: rgb(170,170,170)\">\nUse <a href=\"http://library.elm-lang.org/catalog/elm-lang-Elm/latest/Debug#watchSummary\"><span style=\"text-decoration:underline; color: rgb(170,170,170)\">Debug.watchSummary</span></a> to show a <br>\nsummary or subvalue of any value. </span><br></p>\n<div style=\"height:0;width:0;\"> </div>",+ "320:13");+ var roundedSquare = F3(function (side,+ radius,+ toForm) {+ return function () {+ var formedCircle = toForm($Graphics$Collage.circle(radius));+ var shortSide = side - 2 * radius;+ var xRect = toForm(A2($Graphics$Collage.rect,+ side,+ shortSide));+ var yRect = toForm(A2($Graphics$Collage.rect,+ shortSide,+ side));+ var circleOffset = shortSide / 2;+ var tl = $Graphics$Collage.move({ctor: "_Tuple2"+ ,_0: 0 - circleOffset+ ,_1: circleOffset})(formedCircle);+ var tr = $Graphics$Collage.move({ctor: "_Tuple2"+ ,_0: circleOffset+ ,_1: circleOffset})(formedCircle);+ var bl = $Graphics$Collage.move({ctor: "_Tuple2"+ ,_0: 0 - circleOffset+ ,_1: 0 - circleOffset})(formedCircle);+ var br = $Graphics$Collage.move({ctor: "_Tuple2"+ ,_0: circleOffset+ ,_1: 0 - circleOffset})(formedCircle);+ return $Graphics$Collage.group(_L.fromArray([xRect+ ,yRect+ ,tl+ ,tr+ ,bl+ ,br]));+ }();+ });+ var startState = {_: {}+ ,paused: false+ ,scrubPosition: 0+ ,totalEvents: 0};+ var step = F2(function (update,+ state) {+ return function () {+ switch (update.ctor)+ {case "Pause":+ return _U.replace([["paused"+ ,update._0]+ ,["totalEvents"+ ,update._0 ? state.totalEvents : state.scrubPosition]],+ state);+ case "Restart":+ return startState;+ case "ScrubPosition":+ return _U.replace([["scrubPosition"+ ,update._0]+ ,["paused",true]],+ state);+ case "TotalEvents":+ return _U.replace([["totalEvents"+ ,update._0]+ ,["scrubPosition",update._0]],+ state);}+ _E.Case($moduleName,+ "between lines 265 and 286");+ }();+ });+ var showSwap = $Native$Ports.portIn("showSwap",+ function (v) {+ return typeof v === "boolean" ? v : _E.raise("invalid input, expecting JSBoolean but got " + v);+ });+ var watches = $Native$Ports.portIn("watches",+ $Native$Ports.incomingSignal(function (v) {+ return _U.isJSArray(v) ? _L.fromArray(v.map(function (v) {+ return _U.isJSArray(v) ? {ctor: "_Tuple2"+ ,_0: typeof v[0] === "string" || typeof v[0] === "object" && v[0] instanceof String ? v[0] : _E.raise("invalid input, expecting JSString but got " + v[0])+ ,_1: typeof v[1] === "string" || typeof v[1] === "object" && v[1] instanceof String ? v[1] : _E.raise("invalid input, expecting JSString but got " + v[1])} : _E.raise("invalid input, expecting JSArray but got " + v);+ })) : _E.raise("invalid input, expecting JSArray but got " + v);+ }));+ var eventCounter = $Native$Ports.portIn("eventCounter",+ $Native$Ports.incomingSignal(function (v) {+ return typeof v === "number" ? v : _E.raise("invalid input, expecting JSNumber but got " + v);+ }));+ var scrubInput = $Graphics$Input.input(0);+ var restartInput = $Graphics$Input.input({ctor: "_Tuple0"});+ var permitSwapInput = $Graphics$Input.input(true);+ var pausedInput = $Graphics$Input.input(false);+ var permitSwap = $Native$Ports.portOut("permitSwap",+ $Native$Ports.outgoingSignal(function (v) {+ return v;+ }),+ permitSwapInput.signal);+ var restart = $Native$Ports.portOut("restart",+ $Native$Ports.outgoingSignal(function (v) {+ return v;+ }),+ A2($Signal.lift,+ function (x) {+ return 0;+ },+ restartInput.signal));+ var scrubSlider = F2(function (_v4,+ state) {+ return function () {+ switch (_v4.ctor)+ {case "_Tuple2":+ return function () {+ var sliderLength = _v4._0;+ var sliderStyle = _U.replace([["length"+ ,sliderLength]+ ,["max"+ ,$Basics.toFloat(state.totalEvents)]+ ,["value"+ ,$Basics.toFloat(state.scrubPosition)]],+ $Slider.defaultSlider);+ return A3($Graphics$Element.container,+ sliderLength,+ 20,+ $Graphics$Element.middle)(A3($Slider.slider,+ scrubInput.handle,+ $Basics.round,+ sliderStyle));+ }();}+ _E.Case($moduleName,+ "between lines 115 and 123");+ }();+ });+ var myButton = F3(function (handle,+ value,+ name) {+ return function () {+ var img = function (state) {+ return A3($Graphics$Element.image,+ 40,+ 40,+ _L.append("/_reactor/debugger/",+ _L.append(name,+ _L.append("-button-",+ _L.append(state,".png")))));+ };+ return A5($Graphics$Input.customButton,+ handle,+ value,+ img("up"),+ img("hover"),+ img("down"));+ }();+ });+ var playButton = A3(myButton,+ pausedInput.handle,+ false,+ "play");+ var pauseButton = A3(myButton,+ pausedInput.handle,+ true,+ "pause");+ var restartButton = A3(myButton,+ restartInput.handle,+ {ctor: "_Tuple0"},+ "restart");+ var darkGrey = A3($Color.rgb,+ 74,+ 74,+ 74);+ var lightGrey = A3($Color.rgb,+ 228,+ 228,+ 228);+ var dataStyle = F3(function (typefaces,+ height,+ string) {+ return function () {+ var myStyle = _U.replace([["typeface"+ ,typefaces]+ ,["color",lightGrey]+ ,["height"+ ,$Maybe.Just(height)]],+ $Text.defaultStyle);+ return A2($Text.style,+ myStyle,+ $Text.toText(string));+ }();+ });+ var textStyle = A2(dataStyle,+ _L.fromArray(["Gotham"+ ,"Futura"+ ,"Lucida Grande"+ ,"sans-serif"]),+ 12);+ var watchStyle = A2(dataStyle,+ _L.fromArray(["Gotham"+ ,"Futura"+ ,"Lucida Grande"+ ,"sans-serif"]),+ 14);+ var codeStyle = A2(dataStyle,+ _L.fromArray(["Menlo for Powerline"+ ,"monospace"]),+ 12);+ var blue = A3($Color.rgb,+ 28,+ 129,+ 218);+ var swapButton = function (permitSwap) {+ return function () {+ var info = $Text.leftAligned(textStyle("swap"));+ var radius = 4;+ var hsWidth = 25;+ var bgButton = A3(roundedSquare,+ hsWidth,+ radius,+ $Graphics$Collage.filled(lightGrey));+ var trueButton = _L.fromArray([bgButton+ ,A3(roundedSquare,+ 22,+ radius,+ $Graphics$Collage.filled(blue))]);+ var falseButtonClick = trueButton;+ var trueButtonHover = _L.fromArray([bgButton+ ,A3(roundedSquare,+ 22,+ radius,+ $Graphics$Collage.filled(blue))+ ,$Graphics$Collage.alpha(0.1)(A3(roundedSquare,+ 22,+ radius,+ $Graphics$Collage.filled(darkGrey)))]);+ var falseButton = _L.fromArray([bgButton+ ,A3(roundedSquare,+ 22,+ radius,+ $Graphics$Collage.filled(darkGrey))]);+ var trueButtonClick = falseButton;+ var falseButtonHover = _L.fromArray([bgButton+ ,A3(roundedSquare,+ 22,+ radius,+ $Graphics$Collage.filled(darkGrey))+ ,$Graphics$Collage.alpha(0.1)(A3(roundedSquare,+ 22,+ radius,+ $Graphics$Collage.filled(blue)))]);+ var button = permitSwap ? A5($Graphics$Input.customButton,+ permitSwapInput.handle,+ false,+ A3($Graphics$Collage.collage,+ hsWidth,+ hsWidth,+ trueButton),+ A3($Graphics$Collage.collage,+ hsWidth,+ hsWidth,+ trueButtonHover),+ A3($Graphics$Collage.collage,+ hsWidth,+ hsWidth,+ trueButtonClick)) : A5($Graphics$Input.customButton,+ permitSwapInput.handle,+ true,+ A3($Graphics$Collage.collage,+ hsWidth,+ hsWidth,+ falseButton),+ A3($Graphics$Collage.collage,+ hsWidth,+ hsWidth,+ falseButtonHover),+ A3($Graphics$Collage.collage,+ hsWidth,+ hsWidth,+ falseButtonClick));+ return A2($Graphics$Element.flow,+ $Graphics$Element.right,+ _L.fromArray([info+ ,A2($Graphics$Element.spacer,+ 10,+ 1)+ ,button]));+ }();+ };+ var panelWidth = 275;+ var textHeight = 20;+ var sliderMinMaxText = F2(function (w,+ state) {+ return function () {+ var sliderTotalEvents = A3($Graphics$Element.container,+ w,+ textHeight,+ $Graphics$Element.topRight)($Text.rightAligned(textStyle($String.show(state.totalEvents))));+ var sliderStartText = A3($Graphics$Element.container,+ w,+ textHeight,+ $Graphics$Element.topLeft)($Text.leftAligned(textStyle("0")));+ return A2($Graphics$Element.flow,+ $Graphics$Element.outward,+ _L.fromArray([sliderStartText+ ,sliderTotalEvents]));+ }();+ });+ var sideMargin = 2 * 20;+ var sliderEventText = F2(function (w,+ state) {+ return function () {+ var text$ = $Text.centered(textStyle($String.show(state.scrubPosition)));+ var yPos = $Graphics$Element.absolute($Basics.round(textHeight / 2));+ var totalEvents = $Basics.toFloat(state.totalEvents);+ var scrubPosition = $Basics.toFloat(state.scrubPosition);+ var textWidthOffset = 14;+ var midWidth = $Basics.toFloat(w) - sideMargin - textWidthOffset;+ var leftDistance = _U.eq(totalEvents,+ 0) ? sideMargin / 2 + textWidthOffset / 2 : scrubPosition / totalEvents * midWidth + sideMargin / 2 + textWidthOffset / 2;+ var xPos = $Graphics$Element.absolute($Basics.round(leftDistance));+ var textPosition = A2($Graphics$Element.middleAt,+ xPos,+ yPos);+ return A4($Graphics$Element.container,+ w,+ textHeight,+ textPosition,+ text$);+ }();+ });+ var buttonWidth = 40;+ var buttonHeight = 40;+ var view = F4(function (_v8,+ watches,+ permitSwap,+ state) {+ return function () {+ switch (_v8.ctor)+ {case "_Tuple2":+ return function () {+ var showWatch = function (_v12) {+ return function () {+ switch (_v12.ctor)+ {case "_Tuple2":+ return A2($Graphics$Element.flow,+ $Graphics$Element.down,+ _L.fromArray([$Graphics$Element.width(_v8._0)($Text.leftAligned($Text.bold(watchStyle(_v12._0))))+ ,$Graphics$Element.width(_v8._0)($Text.leftAligned(codeStyle(_v12._1)))+ ,A2($Graphics$Element.spacer,+ 1,+ 12)]));}+ _E.Case($moduleName,+ "between lines 195 and 199");+ }();+ };+ var watchView = A2($Graphics$Element.flow,+ $Graphics$Element.right,+ _L.fromArray([A2($Graphics$Element.spacer,+ 20,+ 1)+ ,function () {+ switch (watches.ctor)+ {case "[]": return noWatches;}+ return $Graphics$Element.flow($Graphics$Element.down)(A2($List.map,+ showWatch,+ watches));+ }()]));+ var bar = A2($Graphics$Element.flow,+ $Graphics$Element.down,+ _L.fromArray([$Graphics$Element.opacity(0.3)($Graphics$Element.color(lightGrey)(A2($Graphics$Element.spacer,+ _v8._0,+ 1)))+ ,A2($Graphics$Element.spacer,+ _v8._0,+ 12)]));+ var fittedSwapButton = showSwap ? A3($Graphics$Element.container,+ _v8._0 - 2 * buttonWidth - sideMargin,+ buttonHeight,+ $Graphics$Element.middle)(swapButton(permitSwap)) : A2($Graphics$Element.spacer,+ 2 * buttonWidth,+ 1);+ var buttons = A2($Graphics$Element.flow,+ $Graphics$Element.right,+ _L.fromArray([restartButton+ ,fittedSwapButton+ ,state.paused ? playButton : pauseButton]));+ var buttonContainer = A4($Graphics$Element.container,+ _v8._0,+ buttonHeight,+ $Graphics$Element.midTop,+ buttons);+ var buttonSliderSpaceHeight = 10;+ var topSpacerHeight = 15;+ var midWidth = _v8._0 - sideMargin;+ var centeredSliderContainer = A3($Graphics$Element.container,+ _v8._0,+ 24 + textHeight,+ $Graphics$Element.midTop)(A2($Graphics$Element.flow,+ $Graphics$Element.down,+ _L.fromArray([A2(scrubSlider,+ {ctor: "_Tuple2"+ ,_0: midWidth+ ,_1: _v8._1},+ state)+ ,A2(sliderMinMaxText,+ midWidth,+ state)])));+ var slider = A3($Graphics$Element.container,+ _v8._0,+ 24 + 2 * textHeight,+ $Graphics$Element.midTop)(A2($Graphics$Element.flow,+ $Graphics$Element.down,+ _L.fromArray([A2(sliderEventText,+ _v8._0,+ state)+ ,centeredSliderContainer])));+ var controls = A2($Graphics$Element.flow,+ $Graphics$Element.down,+ _L.fromArray([A2($Graphics$Element.spacer,+ midWidth,+ topSpacerHeight)+ ,buttonContainer+ ,A2($Graphics$Element.spacer,+ midWidth,+ buttonSliderSpaceHeight)+ ,slider+ ,A2($Graphics$Element.spacer,+ midWidth,+ 10)]));+ return A2($Graphics$Element.flow,+ $Graphics$Element.down,+ _L.fromArray([controls+ ,bar+ ,watchView]));+ }();}+ _E.Case($moduleName,+ "between lines 160 and 210");+ }();+ });+ var State = F3(function (a,+ b,+ c) {+ return {_: {}+ ,paused: a+ ,scrubPosition: c+ ,totalEvents: b};+ });+ var ScrubPosition = function (a) {+ return {ctor: "ScrubPosition"+ ,_0: a};+ };+ var TotalEvents = function (a) {+ return {ctor: "TotalEvents"+ ,_0: a};+ };+ var Pause = function (a) {+ return {ctor: "Pause",_0: a};+ };+ var Restart = {ctor: "Restart"};+ var aggregateUpdates = $Signal.merges(_L.fromArray([A2($Signal._op["<~"],+ $Basics.always(Restart),+ restartInput.signal)+ ,A2($Signal._op["<~"],+ Pause,+ pausedInput.signal)+ ,A2($Signal._op["<~"],+ TotalEvents,+ eventCounter)+ ,A2($Signal._op["<~"],+ ScrubPosition,+ scrubInput.signal)]));+ var scene = A3($Signal.foldp,+ step,+ startState,+ aggregateUpdates);+ var main = A2($Signal._op["~"],+ A2($Signal._op["~"],+ A2($Signal._op["~"],+ A2($Signal._op["<~"],+ view,+ A2($Signal._op["<~"],+ function (_v17) {+ return function () {+ switch (_v17.ctor)+ {case "_Tuple2":+ return {ctor: "_Tuple2"+ ,_0: panelWidth+ ,_1: _v17._1};}+ _E.Case($moduleName,+ "on line 218, column 30 to 43");+ }();+ },+ $Window.dimensions)),+ watches),+ permitSwapInput.signal),+ scene);+ var scrubTo = $Native$Ports.portOut("scrubTo",+ $Native$Ports.outgoingSignal(function (v) {+ return v;+ }),+ A2($Signal._op["<~"],+ function (_) {+ return _.scrubPosition;+ },+ scene));+ var pause = $Native$Ports.portOut("pause",+ $Native$Ports.outgoingSignal(function (v) {+ return v;+ }),+ A2($Signal._op["<~"],+ function (_) {+ return _.paused;+ },+ scene));+ _elm.DebuggerInterface.values = {_op: _op+ ,Restart: Restart+ ,Pause: Pause+ ,TotalEvents: TotalEvents+ ,ScrubPosition: ScrubPosition+ ,State: State+ ,buttonHeight: buttonHeight+ ,buttonWidth: buttonWidth+ ,sideMargin: sideMargin+ ,textHeight: textHeight+ ,panelWidth: panelWidth+ ,blue: blue+ ,lightGrey: lightGrey+ ,darkGrey: darkGrey+ ,dataStyle: dataStyle+ ,textStyle: textStyle+ ,watchStyle: watchStyle+ ,codeStyle: codeStyle+ ,myButton: myButton+ ,playButton: playButton+ ,pauseButton: pauseButton+ ,restartButton: restartButton+ ,swapButton: swapButton+ ,scrubSlider: scrubSlider+ ,sliderEventText: sliderEventText+ ,sliderMinMaxText: sliderMinMaxText+ ,view: view+ ,main: main+ ,pausedInput: pausedInput+ ,permitSwapInput: permitSwapInput+ ,restartInput: restartInput+ ,scrubInput: scrubInput+ ,scene: scene+ ,startState: startState+ ,step: step+ ,aggregateUpdates: aggregateUpdates+ ,roundedSquare: roundedSquare+ ,noWatches: noWatches};+ return _elm.DebuggerInterface.values;+};Elm.Slider = Elm.Slider || {};+Elm.Slider.make = function (_elm) {+ "use strict";+ _elm.Slider = _elm.Slider || {};+ if (_elm.Slider.values)+ return _elm.Slider.values;+ var _op = {},+ _N = Elm.Native,+ _U = _N.Utils.make(_elm),+ _L = _N.List.make(_elm),+ _A = _N.Array.make(_elm),+ _E = _N.Error.make(_elm),+ $moduleName = "Slider",+ $Graphics$Element = Elm.Graphics.Element.make(_elm),+ $Graphics$Input = Elm.Graphics.Input.make(_elm),+ $Native$Slider = Elm.Native.Slider.make(_elm);+ var slider = $Native$Slider.slider;+ var defaultSlider = {_: {}+ ,disabled: false+ ,horizontal: true+ ,length: 100+ ,max: 100+ ,min: 0+ ,step: 1+ ,value: 0};+ var SliderStyle = F7(function (a,+ b,+ c,+ d,+ e,+ f,+ g) {+ return {_: {}+ ,disabled: b+ ,horizontal: a+ ,length: c+ ,max: e+ ,min: d+ ,step: f+ ,value: g};+ });+ _elm.Slider.values = {_op: _op+ ,SliderStyle: SliderStyle+ ,defaultSlider: defaultSlider+ ,slider: slider};+ return _elm.Slider.values;+};+// A note to the reader:+// This file is concatenated with debuggerInterface.elm's compiled+// javascript and debug-core.js. This is done at build time in Setup.hs++var prettyPrint = function(){++ var independentElm = {};+ var NList = Elm.Native.List.make(independentElm);+ var List = Elm.List.make(independentElm);+ var ElmArray = Elm.Array.make(independentElm);+ var Dict = Elm.Dict.make(independentElm);+ var Tuple2 = Elm.Native.Utils.make(independentElm).Tuple2;++ var toString = function(v, separator) {+ var type = typeof v;+ if (type === "function") {+ var name = v.func ? v.func.name : v.name;+ return '<function' + (name === '' ? '' : ': ') + name + '>';+ } else if (type === "boolean") {+ return v ? "True" : "False";+ } else if (type === "number") {+ return v.toFixed(2).replace(/\.0+$/g, '');+ } else if ((v instanceof String) && v.isChar) {+ return "'" + addSlashes(v) + "'";+ } else if (type === "string") {+ return '"' + addSlashes(v) + '"';+ } else if (type === "object" && '_' in v && probablyPublic(v)) {+ var output = [];+ for (var k in v._) {+ for (var i = v._[k].length; i--; ) {+ output.push(k + " = " + toString(v._[k][i], separator));+ }+ }+ for (var k in v) {+ if (k === '_') continue;+ output.push(k + " = " + toString(v[k], separator));+ }+ if (output.length === 0) return "{}";+ var body = "\n" + output.join(",\n");+ return "{" + body.replace(/\n/g,"\n" + separator) + "\n}";+ } else if (type === "object" && 'ctor' in v) {+ if (v.ctor.substring(0,6) === "_Tuple") {+ var output = [];+ for (var k in v) {+ if (k === 'ctor') continue;+ output.push(toString(v[k], separator));+ }+ return "(" + output.join(", ") + ")";+ } else if (v.ctor === "_Array") {+ var list = ElmArray.toList(v);+ return "Array.fromList " + toString(list, separator);+ } else if (v.ctor === "::") {+ var output = '[\n' + toString(v._0, separator);+ v = v._1;+ while (v && v.ctor === "::") {+ output += ",\n" + toString(v._0, separator);+ v = v._1;+ }+ return output.replace(/\n/g,"\n" + separator) + "\n]";+ } else if (v.ctor === "[]") {+ return "[]";+ } else if (v.ctor === "RBNode" || v.ctor === "RBEmpty") {+ var cons = F3(function(k,v,acc){return NList.Cons(Tuple2(k,v),acc)});+ var list = A3(Dict.foldr, cons, NList.Nil, v);+ var name = "Dict";+ if (list.ctor === "::" && list._0._1.ctor === "_Tuple0") {+ name = "Set";+ list = A2(List.map, function(x){return x._0}, list);+ }+ return name + ".fromList " + toString(list, separator);+ } else {+ var output = "";+ for (var i in v) {+ if (i === 'ctor') continue;+ var str = toString(v[i], separator);+ var parenless = str[0] === '{' ||+ str[0] === '<' ||+ str[0] === "[" ||+ str.indexOf(' ') < 0;+ output += ' ' + (parenless ? str : "(" + str + ')');+ }+ return v.ctor + output;+ }+ }+ if (type === 'object' && 'recv' in v) return '<signal>';+ return "<internal structure>";+ };++ function addSlashes(str) {+ return str.replace(/\\/g, '\\\\')+ .replace(/\n/g, '\\n')+ .replace(/\t/g, '\\t')+ .replace(/\r/g, '\\r')+ .replace(/\v/g, '\\v')+ .replace(/\0/g, '\\0')+ .replace(/\'/g, "\\'")+ .replace(/\"/g, '\\"');+ }++ function probablyPublic(v) {+ var keys = Object.keys(v);+ var len = keys.length;+ if (len === 3+ && 'props' in v+ && 'element' in v) return false;+ if (len === 5+ && 'horizontal' in v+ && 'vertical' in v+ && 'x' in v+ && 'y' in v) return false;+ if (len === 7+ && 'theta' in v+ && 'scale' in v+ && 'x' in v+ && 'y' in v+ && 'alpha' in v+ && 'form' in v) return false;+ return true;+ }++ return toString;+}();+// A note to the reader:+// This file is concatenated with debuggerInterface.elm's compiled+// javascript, toString.js, and reactor.js.+// This is done at build time in Setup.hs.++// Options:++// Expose internal swap function, disable swap button, no socket+// options.externalSwap = boolean++ElmRuntime.debugFullscreenWithOptions = function(options) {++ return function(module, moduleFile, swapState /* =undefined */) {+ var createdSocket = false;+ var elmPermitSwaps = true;++ var ELM_DEBUGGER_ID = "elmToolPanel";+ var ELM_DARK_GREY = "#4A4A4A";+ var ELM_LIGHT_GREY = "#E4E4E4";++ var mainHandle = Elm.fullscreenDebugHooks(module, swapState);+ var debuggerHandle = initDebugger();+ if (!options.externalSwap) {+ initSocket();+ }++ parent.window.addEventListener("message", function(e) {+ if (e.data === "elmNotify") {+ var currentPosition = mainHandle.debugger.getMaxSteps();+ if (debuggerHandle.ports) {+ debuggerHandle.ports.eventCounter.send(currentPosition);+ sendWatches(currentPosition);+ }+ }+ }, false);++ function createDebuggingElement() {+ var debuggingPanelExpanded = true;+ var debuggerWidth = 275;++ var debugTools = document.createElement("div");+ debugTools.id = ELM_DEBUGGER_ID;++ var debuggerDiv = document.createElement("div");+ debuggerDiv.id = "elmDebugger";+ debuggerDiv.style.overflow = "hidden";++ // Create and style the panel+ debugTools.style.background = ELM_DARK_GREY;+ debugTools.style.width = debuggerWidth + "px";+ debugTools.style.height = "100%";+ debugTools.style.position = "absolute";+ debugTools.style.top = "0px";+ debugTools.style.right = "0px";+ debugTools.style.transitionDuration = "0.3s";+ debugTools.style.opacity = 0.97;+ debugTools.style.zIndex = 1;++ // Prevent clicks from reaching the main elm instance under the panel+ function stopEvents(e) {+ if (!e) {+ var e = window.event;+ }+ e.cancelBubble = true;+ if (e.stopPropagation) {+ e.stopPropagation();+ }+ }+ debugTools.addEventListener("click", stopEvents);++ // Create and style the button+ var tabWidth = 25;+ var debugTab = document.createElement("div");+ debugTab.id = "debugToggle";+ debugTab.style.position = "absolute";+ debugTab.style.width = tabWidth + "px";+ debugTab.style.height = "60px";+ debugTab.style.top = window.innerHeight / 2 + "px";+ debugTab.style.left = "-" + tabWidth + "px";+ debugTab.style.borderTopLeftRadius = "3px";+ debugTab.style.borderBottomLeftRadius = "3px";+ debugTab.style.background = ELM_DARK_GREY;+++ // Wire the button+ debugTab.onclick = function() {+ var toolPanel = document.getElementById("elmToolPanel");+ if (debuggingPanelExpanded){+ toolPanel.style.width = "0px";+ debuggingPanelExpanded = false;+ } else {+ toolPanel.style.right = "0px";+ toolPanel.style.width = debuggerWidth + "px";+ debuggingPanelExpanded = true;+ }+ };++ debugTools.appendChild(debugTab);+ debugTools.appendChild(debuggerDiv);+ return debugTools;+ }++ function initDebugger() {+ function scrubber(position) {+ if (mainHandle.debugger.getPaused()) {+ mainHandle.debugger.stepTo(position);+ sendWatches(position);+ }+ }++ function elmPauser(doPause) {+ if (doPause) {+ mainHandle.debugger.pause();+ } else {+ mainHandle.debugger.kontinue();+ }+ }++ function elmRestart() {+ mainHandle.debugger.restart();+ sendWatches(0);+ }++ function elmSwap(permitSwaps) {+ elmPermitSwaps = permitSwaps;+ }++ var debugTools = createDebuggingElement();+ document.body.appendChild(debugTools);+ var debuggerDiv = document.getElementById("elmDebugger");++ var handle = Elm.embed(Elm.DebuggerInterface, debuggerDiv,+ { eventCounter: 0,+ watches: [],+ showSwap: !options.externalSwap+ });+ handle.ports.scrubTo.subscribe(scrubber);+ handle.ports.pause.subscribe(elmPauser);+ handle.ports.restart.subscribe(elmRestart);+ handle.ports.permitSwap.subscribe(elmSwap);+ return handle;+ }++ function sendWatches(position) {+ var separator = " ";+ var output = [];++ var watchAtPoint = mainHandle.debugger.watchTracker.frames[position];++ for(key in watchAtPoint) {+ var value = watchAtPoint[key];+ // The toString object is defined in toString.js+ // and is prepended to this file at build time.+ var stringified = prettyPrint(value, separator);+ output.push([key, stringified]);+ }+ debuggerHandle.ports.watches.send(output);+ }++ function initSocket() {+ createdSocket = true;+ // "/todo.html" => "todo.elm"+ moduleFile = moduleFile || window.location.pathname.substr(1).split(".")[0] + ".elm";+ var socketLocation = "ws://" + window.location.host + "/socket?file=" + moduleFile;+ var serverConnection = new WebSocket(socketLocation);+ serverConnection.onmessage = function(event) {+ if (elmPermitSwaps && debuggerHandle.ports) {+ swap(event.data);+ }+ };+ window.addEventListener("unload", function() {+ serverConnection.close();+ });+ }++ function swap(raw) {+ var debuggerDiv = document.getElementById(ELM_DEBUGGER_ID);+ var result = JSON.parse(raw);+ var js = result.success;+ var errorMessage = result.error;+ var error = document.getElementById('ErrorMessage');+ if (error) {+ error.parentNode.removeChild(error);+ }+ if (js) {+ window.eval(js);+ var moduleStr = js.match(/(Elm\..+)\ =\ \1/)[1];+ var module = window.eval(moduleStr);+ if (mainHandle.debugger) {+ var debuggerState = mainHandle.debugger.getSwapState();+ mainHandle.debugger.dispose();+ mainHandle.dispose();++ mainHandle = Elm.fullscreenDebugHooks(module, debuggerState);++ // The div that rejects events must be after Elm+ var ignoringDiv = document.getElementById("elmEventIgnorer");+ if (ignoringDiv) {+ ignoringDiv.parentNode.appendChild(ignoringDiv);+ }+ }+ else {+ mainHandle = mainHandle.swap(module);+ }+ } else if (errorMessage) {+ var errorNode = document.createElement("pre");+ errorNode.id = "ErrorMessage";+ errorNode.innerHTML = errorMessage;+ errorNode.style.zindex = 1;+ errorNode.style.position = "absolute";+ errorNode.style.top = "0";+ errorNode.style.left = "0";+ errorNode.style.color = ELM_DARK_GREY;+ errorNode.style.backgroundColor = ELM_LIGHT_GREY;+ errorNode.style.padding = "1em";+ errorNode.style.margin = "1em";+ errorNode.style.borderRadius = "10px";++ document.body.appendChild(errorNode);+ }+ }++ if (!options.externalSwap) {+ mainHandle.debugger.swap = swap;+ }+ return mainHandle;+ };+};+// A note to the reader:+// This file is concatenated with debuggerInterface.elm's compiled+// javascript, toString.js, and debug-core.js. This is done at build time in Setup.hs++Elm.debugFullscreen = ElmRuntime.debugFullscreenWithOptions({+ externalSwap: false+});
+ assets/favicon.ico view
binary file changed (absent → 1150 bytes)
+ elm-reactor.cabal view
@@ -0,0 +1,72 @@+Name: elm-reactor+Version: 0.1+Synopsis: Interactive development tool for Elm programs+Description: Provides an interactive development tool that makes it easy+ to develop and debug Elm programs. It will automatically+ compile any Elm program—independent of editor. It permits+ hot-swapping and time-traveling debugging.++Homepage: http://elm-lang.org++License: BSD3+License-file: LICENSE++Author: Evan Czaplicki+Maintainer: info@elm-lang.org+Copyright: Copyright: (c) 2011-2014 Evan Czaplicki++Category: Compiler, Language++Build-type: Simple++Data-dir: assets+Data-files: favicon.ico+ debugger.js+ _reactor/wrench.png+ _reactor/debugger/pause-button-up.png+ _reactor/debugger/pause-button-down.png+ _reactor/debugger/pause-button-hover.png+ _reactor/debugger/play-button-up.png+ _reactor/debugger/play-button-down.png+ _reactor/debugger/play-button-hover.png+ _reactor/debugger/restart-button-up.png+ _reactor/debugger/restart-button-down.png+ _reactor/debugger/restart-button-hover.png++Extra-source-files: README.md+Cabal-version: >=1.8++source-repository head+ type: git+ location: git://github.com/elm-lang/elm-reactor.git++Executable elm-reactor+ Main-is: Server.hs+ ghc-options: -threaded -O2+ other-modules: Generate,+ Index,+ Socket,+ Utils+ Build-depends: base >=4.2 && <5,+ blaze-html,+ blaze-markup,+ bytestring,+ cmdargs,+ containers >= 0.3,+ directory >= 1.2,+ Elm >= 0.13,+ filepath,+ fsnotify >= 0.1.0.2,+ HTTP,+ mtl,+ process,+ snap-core,+ snap-server,+ system-filepath,+ time,+ transformers,+ unordered-containers,+ websockets >= 0.9 && < 0.10,+ websockets-snap >= 0.8.2.1+ + hs-source-dirs: server
+ server/Generate.hs view
@@ -0,0 +1,107 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings #-}+module Generate (html, js) where++import Control.Monad (forM_)+import Data.Maybe (fromMaybe)+import System.Exit+import System.FilePath+import System.Process+import System.IO (hGetContents)+import Text.Blaze (preEscapedToMarkup)+import Text.Blaze.Html5 ((!))+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A++import qualified Elm.Internal.Utils as Elm++-- | Using a page title and the full source of an Elm program, compile down to+-- a valid HTML document.+html :: FilePath -> Bool -> IO H.Html+html filePath doDebug =+ do src <- readFile filePath+ compilerResult <- compile filePath+ return . buildPage $ formatResult src compilerResult+ where+ script = H.script ! A.type_ "text/javascript"++ formatResult src compilerResult =+ case compilerResult of+ Right jsSrc ->+ do script $ preEscapedToMarkup jsSrc+ script $ preEscapedToMarkup $ runFullscreen src+ Left err ->+ H.span ! A.style "font-family: monospace;" $+ forM_ (lines err) $ \line ->+ do preEscapedToMarkup (addSpaces line)+ H.br++ attachDebugger moduleName =+ case doDebug of+ True -> "Elm.debugFullscreen(" ++ moduleName ++ ", \"" ++ filePath ++ "\");"+ False -> "Elm.fullscreen(" ++ moduleName ++ ");"++ runFullscreen src =+ let moduleName = "Elm." ++ fromMaybe "Main" (Elm.moduleName src)+ in "var runningElmModule = " ++ (attachDebugger moduleName)++ insertDebuggerScript =+ case doDebug of+ True -> script ! A.src (H.toValue ("/debugger.js" :: String)) $ ""+ False -> return ()++ buildPage content = H.docTypeHtml $ do+ H.head $ do+ H.meta ! A.charset "UTF-8"+ H.title . H.toHtml $ takeFileName filePath+ H.style ! A.type_ "text/css" $ preEscapedToMarkup+ ("a:link {text-decoration: none; color: rgb(15,102,230);}\n\+ \a:visited {text-decoration: none}\n\+ \a:active {text-decoration: none}\n\+ \a:hover {text-decoration: underline; color: rgb(234,21,122);}\n\+ \html,body {height: 100%; margin: 0px;}" :: String)+ H.body $ do+ script ! A.src (H.toValue ("/elm-runtime.js" :: String)) $ ""+ insertDebuggerScript+ content++-- | Creates the javascript for the elm program and returns it as a +-- JSONified string with either success:<code> or error:<message>+js :: FilePath -> IO String+js filePath =+ do output <- compile filePath+ return (either (wrap "error") (wrap "success") output)+ where+ wrap :: String -> String -> String+ wrap typ msg = "{ " ++ show typ ++ " : " ++ show msg ++ " }"++addSpaces :: String -> String+addSpaces str =+ case str of+ ' ' : ' ' : rest -> " " ++ addSpaces rest+ c : rest -> c : addSpaces rest+ [] -> []++compile :: FilePath -> IO (Either String String)+compile filePath =+ do (_, Just hout, Just herr, p) <- createProcess (proc "elm" $ args fileName)+ { cwd = Just directory+ , std_out = CreatePipe+ , std_err = CreatePipe+ }+ exitCode <- waitForProcess p+ stdout <- exitCode `seq` hGetContents hout+ stderr <- exitCode `seq` hGetContents herr+ case exitCode of+ ExitFailure _ ->+ do return (Left (stdout ++ stderr))+ ExitSuccess ->+ do result <- readFile (directory </> "build" </> fileName `replaceExtension` "js")+ return (Right result)+ where+ (directory, fileName) = splitFileName filePath+ args file =+ [ "--make"+ , "--only-js"+ , file+ ]
+ server/Index.hs view
@@ -0,0 +1,201 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings #-}+module Index (elmIndexGenerator) where++import Control.Monad+import Control.Monad.IO.Class+import qualified Data.ByteString.Char8 as S+import Data.List (sort, partition, intercalate)+import Data.Time.Clock (diffUTCTime, getCurrentTime)+import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents, getModificationTime)+import System.FilePath ((</>), takeExtension, splitDirectories)+import Snap.Core (MonadSnap, modifyResponse, setContentType, writeBS)++indexStyle :: S.ByteString+indexStyle =+ S.intercalate "\n"+ [ "body {"+ , " margin: 0;"+ , " background: rgb(253,253,253);"+ , " font-family: 'Lucida Grande','Trebuchet MS','Bitstream Vera Sans',Verdana,Helvetica,sans-serif;"+ , "}"+ , "div.topbar {"+ , " height: 6px;"+ , " background-color: rgb(96,181,204);"+ , "}"+ , "div.header {"+ , " padding: 20px 50px;"+ , " font-size: 30px;"+ , "}"+ , "div.content { padding: 0 40px }"+ , "table {"+ , " width:100%;"+ , " border-collapse: collapse;"+ , " margin-bottom: 40px;"+ , " float: left"+ , "}"+ , "a { text-decoration: none; color:rgb(96,181,204) }"+ , "td { padding: 8px 10px; color:rgb(136,136,136) }"+ , "tr { border-bottom: solid rgb(245,245,245) 1px }"+ , "th {"+ , " text-align: left;"+ , " padding: 6px 10px;"+ , " font-weight: normal;"+ , " font-size: 24px;"+ , "}"+ ]++writeS :: MonadSnap m => FilePath -> m ()+writeS = writeBS . S.pack+++replaceChar :: Char -> Char -> String -> String+replaceChar old new string =+ map (\c -> if c == old then new else c) string+++makeSafe :: String -> String+makeSafe filePath =+ replaceChar ' ' '+' filePath+++writeLink :: MonadSnap m => String -> String -> m ()+writeLink href name =+ do writeBS "<a href=\""+ writeS (makeSafe href)+ writeBS "\">"+ writeS name+ writeBS "</a>"+++timeSince :: MonadSnap m => FilePath -> m String+timeSince filePath =+ do modificationTime <- liftIO $ getModificationTime filePath+ currentTime <- liftIO getCurrentTime+ return (showDiff currentTime modificationTime)+ where+ showDiff currentTime modificationTime =+ case diffUTCTime currentTime modificationTime of+ diff+ | diff < minute -> format diff second "second"+ | diff < hour -> format diff minute "minute"+ | diff < day -> format diff hour "hour"+ | diff < year -> format diff day "day"+ | otherwise -> format diff year "year"++ format diff scale name =+ let t :: Integer+ t = round (diff / scale)+ in+ show t ++ " " ++ name ++ (if t == 1 then "" else "s") ++ " ago"++ second = 1+ minute = 60 * second+ hour = 60 * minute+ day = 24 * hour+ year = 365 * day+++elmIndexGenerator :: MonadSnap m => FilePath -> m ()+elmIndexGenerator directory =+ do modifyResponse $ setContentType "text/html; charset=utf-8"++ let title =+ intercalate "/" $+ case splitDirectories directory of+ "." : rest -> "~" : rest+ path -> path++ writeBS "<!DOCTYPE html>\n<html>\n<head>"+ writeBS "<title>"+ writeS title+ writeBS "</title>"+ writeBS "<style type='text/css'>"+ writeBS indexStyle+ writeBS "</style></head><body>"++ writeBS "<div class=\"topbar\"></div>"++ writeBS "<div class=\"header\">"+ writeLink "/" "~"+ writeBS " / "+ case splitDirectories directory of+ _ : pathParts@(_:_) -> do+ let fullPaths = scanl1 (\a b -> a ++ "/" ++ b) pathParts+ forM_ (zip pathParts fullPaths) $ \(part, fullPath) -> do+ writeLink ("/" ++ fullPath) part+ writeBS " / "+ _ -> return ()++ writeBS "</div>"++ writeBS "<div class=\"content\">"++ entries <- liftIO $ getDirectoryContents directory+ allDirs <- liftIO $ filterM (doesDirectoryExist . (directory </>)) entries+ files <- liftIO $ filterM (doesFileExist . (directory </>)) entries++ let (elmFiles, otherFiles) =+ partition (\file -> takeExtension file == ".elm") files++ let dotFile filePath =+ null filePath || head filePath == '.'++ let keepDir dir =+ dir /= "cache" &&+ dir /= "build" &&+ not (dotFile dir)++ let dirs = sort (filter keepDir allDirs)++ let nonElmFiles = sort $ filter (not . dotFile) otherFiles++ unless (null dirs) $ do+ writeBS "<table><tr><th>Directories</th></tr>"+ forM_ dirs $ \dir -> do+ writeBS "<tr><td>"+ writeLink (dir ++ "/") dir+ writeBS "</td></tr>"+ writeBS "</table>"++ unless (null elmFiles) $ do+ writeBS "<table><tr><th>Elm Files</th><th></th></tr>"+ forM_ (sort elmFiles) $ \filePath -> do+ writeBS "<tr>"++ writeBS "<td>"+ writeLink+ ("/" ++ intercalate "/" (splitDirectories directory) ++ "/" ++ filePath ++ "?debug")+ "<img title=\"Debug mode\" src=/_reactor/wrench.png width=\"12\" height=\"12\">"+ writeBS " "+ writeLink filePath filePath+ writeBS "</td>"++ writeBS "<td style=\"text-align:right;\">"+ writeS =<< timeSince (directory </> filePath)+ writeBS "</td>"++ writeBS "</tr>"+ writeBS "</table>"++ unless (null nonElmFiles) $ do+ writeBS "<table>"+ writeBS "<tr><th>Other Files</th><th></th></tr>"+ forM_ nonElmFiles $ \filePath -> do+ writeBS "<tr>"++ writeBS "<td>"+ writeLink filePath filePath + writeBS "</td>"++ writeBS "<td style=\"text-align:right;\">"+ writeS =<< timeSince (directory </> filePath)+ writeBS "</td>"++ writeBS "</tr>"+ writeBS "</table>"++ writeBS "</div>"+ writeBS "</body>"+ writeBS "</html>"+
+ server/Server.hs view
@@ -0,0 +1,152 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}+module Main where++import Control.Applicative ((<$>),(<|>))+import Control.Monad (guard)+import Control.Monad.Trans (MonadIO(liftIO))+import qualified Data.ByteString.Char8 as BSC+import qualified Data.Version as Version+import qualified Network.WebSockets.Snap as WSS+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html.Renderer.Utf8 as BlazeBS+import System.Console.CmdArgs+import System.Directory+import System.FilePath+import System.Process+import System.IO (hGetContents)+import Paths_elm_reactor (version)+import qualified Elm.Internal.Paths as Elm+import Snap.Core+import Snap.Http.Server+import Snap.Util.FileServe++import Index+import qualified Generate+import qualified Socket+import qualified Utils++data Flags = Flags+ { port :: Int+ , runtime :: Maybe FilePath+ } deriving (Data,Typeable,Show,Eq)++flags :: Flags+flags = Flags+ { port = 8000 &= help "set the port of the reactor"+ , runtime = Nothing &= typFile+ &= help "Specify a custom location for Elm's runtime system."+ } &= help "Interactive development tool that makes it easy to develop and debug Elm programs.\n\+ \ Read more about it at <https://github.com/elm-lang/elm-reactor>."+ &= helpArg [explicit, name "help", name "h"]+ &= versionArg [ explicit, name "version", name "v"+ , summary (Version.showVersion version)+ ]+ &= summary ("Elm Reactor " ++ Version.showVersion version +++ ", (c) Evan Czaplicki 2011-2014")+++config :: Int -> Config Snap a+config portNumber =+ setBind "localhost" $+ setPort portNumber $+ setAccessLog ConfigNoLog $+ setErrorLog ConfigNoLog $+ defaultConfig++-- | Set up the reactor.+main :: IO ()+main = do+ cargs <- cmdArgs flags+ (_,Just h,_,_) <- createProcess $ (shell "elm --version") { std_out = CreatePipe }+ elmVer <- hGetContents h+ putStrLn (startupMessage elmVer)+ httpServe (config (port cargs)) $+ serveRuntime (maybe Elm.runtime id (runtime cargs))+ <|> serveElm+ <|> route [ ("socket", socket) ]+ <|> serveDirectoryWith directoryConfig "."+ <|> serveAssets+ <|> error404++startupMessage :: String -> String+startupMessage elmVer =+ "Elm Reactor " ++ Version.showVersion version ++ ", backed by version " +++ filter (/= '\n') elmVer ++ " of the compiler."++directoryConfig :: MonadSnap m => DirectoryConfig m+directoryConfig =+ fancyDirectoryConfig+ { indexFiles = []+ , indexGenerator = elmIndexGenerator+ }++runtimeName :: String+runtimeName = "elm-runtime.js"++serveRuntime :: FilePath -> Snap ()+serveRuntime runtimePath =+ do file <- BSC.unpack . rqPathInfo <$> getRequest+ guard (file == runtimeName)+ serveFileAs "application/javascript" runtimePath++socket :: Snap ()+socket = maybe error400 socketSnap =<< getParam "file"+ where+ socketSnap fileParam =+ WSS.runWebSocketsSnap $ Socket.fileChangeApp $ BSC.unpack fileParam++withFile :: (FilePath -> H.Html) -> Snap ()+withFile handler =+ do filePath <- BSC.unpack . rqPathInfo <$> getRequest+ exists <- liftIO (doesFileExist filePath)+ if not exists then error404 else+ serveHtml $ handler filePath++error400 :: Snap ()+error400 = modifyResponse $ setResponseStatus 400 "Bad Request"++error404 :: Snap ()+error404 = modifyResponse $ setResponseStatus 404 "Not Found"++serveHtml :: MonadSnap m => H.Html -> m ()+serveHtml html =+ do _ <- setContentType "text/html" <$> getResponse+ writeLBS (BlazeBS.renderHtml html)++serveElm :: Snap ()+serveElm =+ let despace = map (\c -> if c == '+' then ' ' else c) in+ do file <- despace . BSC.unpack . rqPathInfo <$> getRequest+ debugParam <- getParam "debug"+ let doDebug = maybe False (const True) debugParam+ exists <- liftIO $ doesFileExist file+ guard (exists && takeExtension file == ".elm")+ result <- liftIO $ Generate.html file doDebug+ serveHtml result++serveAsset :: FilePath -> Snap ()+serveAsset assetPath =+ do dataPath <- liftIO $ Utils.getDataFile assetPath+ serveFile dataPath++staticAssets :: [FilePath]+staticAssets = [ "favicon.ico"+ , "debugger.js"+ , "_reactor/wrench.png"+ , "_reactor/debugger/pause-button-up.png"+ , "_reactor/debugger/pause-button-down.png"+ , "_reactor/debugger/pause-button-hover.png"+ , "_reactor/debugger/play-button-up.png"+ , "_reactor/debugger/play-button-down.png"+ , "_reactor/debugger/play-button-hover.png"+ , "_reactor/debugger/restart-button-up.png"+ , "_reactor/debugger/restart-button-down.png"+ , "_reactor/debugger/restart-button-hover.png"+ ]++serveAssets :: Snap ()+serveAssets =+ do file <- BSC.unpack . rqPathInfo <$> getRequest+ guard (file `elem` staticAssets)+ serveAsset file
+ server/Socket.hs view
@@ -0,0 +1,57 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings #-}+module Socket where++import Control.Monad.Trans (MonadIO(liftIO))+import Control.Concurrent (threadDelay, forkIO, killThread, ThreadId)+import qualified Control.Exception as E+import qualified Data.ByteString.Char8 as BSC+import qualified Filesystem.Path.CurrentOS as FP+import qualified Network.WebSockets as WS+import qualified System.FSNotify.Devel as NDevel+import qualified System.FSNotify as Notify++import qualified Generate++fileChangeApp :: FilePath -> WS.ServerApp+fileChangeApp watchedFile pendingConnection =+ do connection <- WS.acceptRequest pendingConnection+ Notify.withManager $ \notifyManager -> do+ _ <- NDevel.treeExtExists notifyManager "." "elm" (sendHotSwap watchedFile connection)+ keepAlive connection+++sendHotSwap :: FilePath -> WS.Connection -> FP.FilePath -> IO ()+sendHotSwap watchedFile connection _ =+ do result <- liftIO (Generate.js watchedFile)+ WS.sendTextData connection (BSC.pack result)+++keepAlive :: WS.Connection -> IO ()+keepAlive connection =+ loop+ where+ loop :: IO ()+ loop = do+ pingThread <- forkIO ping+ listen pingThread++ ping :: IO ()+ ping = do+ threadDelay (10 * 1000000) -- 10 seconds+ WS.sendPing connection ("ping" :: BSC.ByteString) `E.catch` connectionClosed++ connectionClosed :: E.SomeException -> IO ()+ connectionClosed _ = return ()++ listen :: ThreadId -> IO ()+ listen pingThread = do+ pong <- WS.receive connection+ case pong of+ WS.DataMessage _ -> listen pingThread+ WS.ControlMessage controlMessage ->+ case controlMessage of+ WS.Ping _ -> listen pingThread+ WS.Pong _ -> loop+ WS.Close _ _ ->+ killThread pingThread >> return ()
+ server/Utils.hs view
@@ -0,0 +1,38 @@+{-# OPTIONS_GHC -Wall #-}+module Utils where++import System.Directory (doesFileExist)+import System.Environment (getEnv)+import System.FilePath ((</>))+import System.IO.Error (tryIOError)+import qualified Paths_elm_reactor as This++-- |The absolute path to a data file+getDataFile :: FilePath -> IO FilePath+getDataFile name = do+ path <- This.getDataFileName name+ exists <- doesFileExist path+ if exists+ then return path+ else do+ environment <- tryIOError (getEnv "ELM_HOME")+ case environment of+ Right env -> return (env </> "reactor" </> name)+ Left _ ->+ fail $ unlines+ [ "Unable to find the ELM_HOME environment variable when searching"+ , "for the " ++ name ++ " file."+ , ""+ , "If you installed Elm Platform with the Mac or Windows installer, it looks like"+ , "ELM_HOME was not set automatically. Look up how to set environment variables"+ , "on your platform and set ELM_HOME to the directory that contains Elm's static"+ , "files:"+ , ""+ , " * On Mac it is /usr/local/share/elm"+ , " * On Windows it is one of the following:"+ , " C:/Program Files/Elm Platform/0.13/share"+ , " C:/Program Files (x86)/Elm Platform/0.13/share"+ , ""+ , "If it seems like a more complex issue, please report it here:"+ , " <https://github.com/elm-lang/elm-platform/issues>"+ ]