Simplify playground code and add snippets. (#136)

* Add instructions for how to run the playground locally.
* Make it easier to select backend in the elm code.
* Use scrolling for long scripts.
* Fix bug, send code to backend on connect, don't auto play on code changes.
* Compile and cache snippets.

.github/workflows/gh-pages.yml

@@ -82,7 +82,11 @@ jobs:
     - name: Playground
       run: |
         CWD=`pwd`
-        cd reanimate-playground/viewer-elm
+        stack build
+        cd reanimate-playground
+        stack build
+        stack exec --cwd ../ playground snippets reanimate-playground/snippets > viewer-elm/dist/snippets.js
+        cd viewer-elm
         npm install
         npm run build
         mkdir $CWD/hpc/playground

reanimate-playground/README.md

@@ -18,3 +18,22 @@ Test against:
 
 
 
+# How to run locally:
+
+## Backend
+
+```
+stack build
+stack exec --cwd ../ playground
+```
+
+## Frontend
+
+By default the frontend will use the backend running at reanimate.clozecards.com.
+To switch to a local backend, change 'backend' in Main.elm to 'Local'.
+
+```
+cd viewer-elm
+npm install
+npm run dev-server
+```

reanimate-playground/hie.yaml

@@ -1,3 +1,2 @@
 cradle:
-  stack:
+  stack: {component: "playground"}
-    component: "playground"

reanimate-playground/playground.cabal

@@ -23,6 +23,7 @@ executable playground
         githash -any,
         time -any,
         haskell-src-exts -any,
+        temporary,
         websockets -any,
         warp,
         wai-app-static

reanimate-playground/src/Main.hs

@@ -34,6 +34,7 @@ import           System.Directory
 import           System.Environment
 import           System.Exit
 import           System.FilePath
+import           System.IO.Temp
 import           System.IO
 import           System.Process
 import           System.Timeout
@@ -83,6 +84,22 @@ main = do
   args <- getArgs
   case args of
     ["test"] -> putStrLn "Test OK"
+    ["snippets", folder] -> do
+      files <- sort <$> getDirectoryContents folder
+      ghci <- takeMVar (backendGhci backend)
+      snippets <- mapM (genSnippet ghci)
+        [ folder </> file
+        | file <- files, takeExtension file == ".hs" ]
+      putStr "const snippets = "
+      putStrLn $
+        "[" ++ intercalate ","
+        [ "{" ++
+          "\"title\": " ++ show title ++ "," ++
+          "\"url\": " ++ show url ++ "," ++
+          "\"code\": " ++ show inp ++
+          "}"
+        | (title, url, inp) <- snippets ] ++
+        "];"
     [] -> do
       root <- cacheDir
       tid <- forkIO $ run 10162 (staticApp $ defaultWebAppSettings root)
@@ -91,6 +108,23 @@ main = do
       hPutStrLn stderr "Invalid arguments"
       exitWith (ExitFailure 1)
 
+genSnippet :: Ghci -> FilePath -> IO (String, String, Text)
+genSnippet ghci path = do
+    inp <- T.readFile path
+    let ParseOk m = parseHaskell inp
+        h = sourceHash m
+    withHaskellFile m $ \hsFile -> do
+      _ <- reqGhcOutput ghci $ ":load " ++ hsFile
+      out <- reqGhcOutput ghci "Reanimate.duration animation"
+      let dur = read (unlines out) :: Double
+          frames = round (dur * fromIntegral frameRate) :: Int
+          url = "https://reanimate.clozecards.com/" ++ h ++ "/" ++ show (frames `div` 2) ++ ".svg"
+          title = takeWhileEnd (/= '_') (takeBaseName path)
+      return (title, url, inp)
+  where
+    takeWhileEnd f = reverse . takeWhile f . reverse
+
+
 opts :: ConnectionOptions
 opts = defaultConnectionOptions
   { connectionCompressionOptions = PermessageDeflateCompression defaultPermessageDeflate }
@@ -189,10 +223,10 @@ requestRender backend render = do
 newGhci :: IO Ghci
 newGhci = do
   let fastProc = proc "stack" ["exec", "ghci", "--rts-options="++memoryLimit]
-  (fastGhci, _loads) <- startGhciProcess fastProc (\_stream msg -> putStrLn msg)
+  (fastGhci, _loads) <- startGhciProcess fastProc (\_stream msg -> hPutStrLn stderr msg)
 
-  void $ exec fastGhci "import qualified Reanimate"
+  void $ reqGhcOutput fastGhci "import qualified Reanimate"
-  void $ exec fastGhci "import qualified Reanimate.Render as Reanimate"
+  void $ reqGhcOutput fastGhci "import qualified Reanimate.Render as Reanimate"
   return fastGhci
 
 newBackend :: IO Backend
@@ -201,8 +235,7 @@ newBackend = do
   queue <- newEmptyMVar
   tid <- forkIO $ forever $ do
     req <- takeMVar queue
-    guardWanted req $ do
+    guardWanted req $ withHaskellFile (renderCode req) $ \hs -> do
-      hs <- writeHaskellFile (renderCode req)
       ghci <- readMVar ghciRef
       guardGhci req ghci (":load " ++ hs) $ \_ -> guardWanted req $
         guardGhci req ghci "Reanimate.duration animation" $ \out -> do
@@ -247,8 +280,9 @@ cacheDir = do
   createDirectoryIfMissing True root
   return root
 
-writeHaskellFile :: Module SrcSpanInfo -> IO FilePath
+withHaskellFile :: Module SrcSpanInfo -> (FilePath -> IO a) -> IO a
-writeHaskellFile m = do
+withHaskellFile m action = withSystemTempFile "playground.hs" $ \target h -> do
+    hClose h
     T.writeFile target  "{-# LANGUAGE OverloadedStrings #-}\n"
     T.appendFile target "module Animation where\n"
     T.appendFile target "import Reanimate\n"
@@ -262,9 +296,7 @@ writeHaskellFile m = do
     T.appendFile target "import Control.Lens\n"
     T.appendFile target "import Codec.Picture.Types\n"
     T.appendFile target $ T.pack $ prettyPrint m
-    return target
+    action target
-  where
-    target = "playground.hs"
 
 splitGhciOutput :: Ghci -> String -> IO ([String], [String])
 splitGhciOutput ghci cmd = do
@@ -276,6 +308,13 @@ splitGhciOutput ghci cmd = do
       Stderr -> modifyIORef err (++[msg])
   (,) <$> readIORef err <*> readIORef out
 
+reqGhcOutput :: Ghci -> String -> IO [String]
+reqGhcOutput ghci cmd = do
+  (err, out) <- splitGhciOutput ghci cmd
+  unless (null err) $
+    error (unlines err)
+  return out
+
 logMsg :: String -> IO ()
 logMsg msg = do
     now <- getCurrentTime

reanimate-playground/viewer-elm/dist/index.html

@@ -22,6 +22,7 @@
   <link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bulma@0.9.0/css/bulma.min.css">
   <link rel="stylesheet" href="style.css">
 
+  <script src="snippets.js"></script>
   <script src="playground.js"></script>
 </head>
 
@@ -41,10 +42,6 @@
 
   <div class="grid">
     <div class="edit-box">
-      <select class="column-header">
-        <option>Example 1</option>
-        <option>Example 2</option>
-      </select>
       <div id="editor"></div>
     </div>
     <div class="gutter-column-1"></div>
@@ -60,7 +57,10 @@
             <img id="seek1" src="skip_next-white-48dp.svg">
             <img id="seek10" src="forward_10-white-48dp.svg">
           </div>
-          <img id="help" src="help_outline-white-48dp.svg">
+          <div>
+            <img id="examples" src="collections-white-48dp.svg">
+            <img id="help" src="help_outline-white-48dp.svg">
+          </div>
         </div>
       </div>
       <div id="elm"></div>
@@ -85,6 +85,45 @@
     <button class="modal-close is-large" area-label="close"></button>
   </div>
 
+  <div id="examples-modal" class="modal">
+    <div class="modal-background"></div>
+    <div class="modal-card">
+      <header class="modal-card-head">
+        <p class="modal-card-title">Reanimate Examples</p>
+        <button class="delete" aria-label="close"></button>
+      </header>
+      <section class="modal-card-body">
+        <!-- 
+          Title
+          Url
+          Code
+        -->
+        <div class="snippet-container">
+          <!-- <div>
+            <span>drawBox</span>
+            <img src="https://reanimate.clozecards.com/EwyRzmx8zxM/30.svg">
+          </div>
+          <div>
+            <span>drawCircle</span>
+            <img src="https://reanimate.clozecards.com/EwyRzmx8zxM/50.svg">
+          </div>
+          <div>2</div>
+          <div>3</div>
+          <div>4</div>
+          <div>5</div>
+          <div>6</div>
+          <div>7</div>
+          <div>8</div>
+          <div>9</div>
+          <div>10</div> -->
+        </div>
+      </section>
+      <!-- <footer class="modal-card-foot">
+      </footer> -->
+    </div>
+    <button class="modal-close is-large" area-label="close"></button>
+  </div>
+
   <script type="text/javascript">
     var app = playgroundInit('elm');
 
@@ -95,54 +134,69 @@
       lineWrapping: true
     });
 
+    app.newCode(myCodeMirror.getValue());
 
     myCodeMirror.on('change', function () {
       document.querySelector('.media-buttons').classList.remove('paused');
-      app.play();
       app.newCode(myCodeMirror.getValue());
     });
 
-    document.getElementById('play').onclick = function() {
+    renderSnippets(document.querySelector('.snippet-container'), myCodeMirror);
+
+    document.getElementById('play').onclick = function () {
       document.querySelector('.media-buttons').classList.toggle('paused');
       app.play();
     };
-    document.getElementById('pause').onclick = function() {
+    document.getElementById('pause').onclick = function () {
       document.querySelector('.media-buttons').classList.toggle('paused');
       app.pause();
     };
-    document.getElementById('seek1').onclick = function() {
+    document.getElementById('seek1').onclick = function () {
       document.querySelector('.media-buttons').classList.add('paused');
       app.pause();
       app.seek1();
     };
-    document.getElementById('seek10').onclick = function() {
+    document.getElementById('seek10').onclick = function () {
       document.querySelector('.media-buttons').classList.add('paused');
       app.pause();
       app.seek10();
     };
-    document.getElementById('seek-1').onclick = function() {
+    document.getElementById('seek-1').onclick = function () {
       document.querySelector('.media-buttons').classList.add('paused');
       app.pause();
       app.seek_1();
     };
-    document.getElementById('seek-10').onclick = function() {
+    document.getElementById('seek-10').onclick = function () {
       document.querySelector('.media-buttons').classList.add('paused');
       app.pause();
       app.seek_10();
     };
-    document.getElementById('help').onclick = function() {
+    document.getElementById('help').onclick = function () {
       document.querySelector('#help-modal').classList.add('is-active');
     };
-    document.querySelector('#help-modal .modal-background').onclick = function() {
+    document.querySelector('#help-modal .modal-background').onclick = function () {
       document.querySelector('#help-modal').classList.remove('is-active');
     };
-    document.querySelector('#help-modal .modal-close').onclick = function() {
+    document.querySelector('#help-modal .modal-close').onclick = function () {
       document.querySelector('#help-modal').classList.remove('is-active');
     };
-    document.querySelector('#help-modal .delete').onclick = function() {
+    document.querySelector('#help-modal .delete').onclick = function () {
       document.querySelector('#help-modal').classList.remove('is-active');
     };
 
+    document.getElementById('examples').onclick = function () {
+      document.querySelector('#examples-modal').classList.add('is-active');
+    };
+    document.querySelector('#examples-modal .modal-background').onclick = function () {
+      document.querySelector('#examples-modal').classList.remove('is-active');
+    };
+    document.querySelector('#examples-modal .modal-close').onclick = function () {
+      document.querySelector('#examples-modal').classList.remove('is-active');
+    };
+    document.querySelector('#examples-modal .delete').onclick = function () {
+      document.querySelector('#examples-modal').classList.remove('is-active');
+    };
+
   </script>
   <script>
     Split({ // gutters specified in options

reanimate-playground/viewer-elm/dist/playground.js

@@ -3,11 +3,13 @@ const backend = "149.56.132.163";
 function playgroundInit(elt) {
   var mySockets = {};
   var frames = {};
+  var lastScript = "";
 
   function sendSocketCommand(wat) {
     if (wat.cmd == "connect") {
       socket = new WebSocket(wat.address);
       socket.onopen = function (event) {
+        socket.send(lastScript);
         app.ports.receiveSocketMsg.send({
           name: wat.name,
           msg: "data",
@@ -42,7 +44,9 @@ function playgroundInit(elt) {
       socket.onclose = connectionFailedHandler;
       mySockets[wat.name] = socket;
     } else if (wat.cmd == "send") {
-      mySockets[wat.name].send(wat.content);
+      if( mySockets[wat.name].readyState === mySockets[wat.name].OPEN ) {
+        mySockets[wat.name].send(wat.content);
+      }
     } else if (wat.cmd == "close") {
       mySockets[wat.name].close();
       delete mySockets[wat.name];
@@ -73,7 +77,26 @@ function playgroundInit(elt) {
       app.ports.receiveControlMsg.send('seek-10');
     },
     newCode: function(code) {
+      lastScript = code;
       app.ports.receiveEditorMsg.send(code);
     }
   };
 }
+
+function renderSnippets(elt, myCodeMirror) {
+  for(var i=0;i<snippets.length;i++) {
+    const div = document.createElement("div");
+    const title = document.createElement("span");
+    const img = document.createElement("img");
+    const code = snippets[i].code;
+    title.innerHTML = snippets[i].title;
+    img.src = snippets[i].url;
+    div.appendChild(title)
+    div.appendChild(img)
+    div.onclick = function () {
+      myCodeMirror.setValue(code);
+      document.querySelector('#examples-modal').classList.remove('is-active');
+    };
+    elt.appendChild(div)
+  }
+}

reanimate-playground/viewer-elm/dist/snippets.js

@@ -0,0 +1 @@
+const snippets = [{"title": "Composition","url": "https://reanimate.clozecards.com/ATcv1$xjG06/30.svg","code": "animation :: Animation\nanimation = docEnv $\n  drawBox `parA` drawCircle\n\n"},{"title": "Color Maps","url": "https://reanimate.clozecards.com/HPNi7PpImrc/15.svg","code": "animation :: Animation\nanimation = docEnv $ staticFrame 1 $\n  showColorMap parula\n"}];

reanimate-playground/viewer-elm/dist/style.css

@@ -106,6 +106,7 @@ pre {
 }
 .edit-box #editor {
   flex: 1 1 auto;
+  max-height: 100vh;
 }
 .edit-box .app {
   flex: 1 1 auto;
@@ -121,6 +122,27 @@ pre {
   cursor: pointer;
 }
 
+.snippet-container {
+  display: flex;
+  justify-content: space-around;
+  flex-wrap: wrap;
+}
+.snippet-container > div {
+  width: 16em;
+  height: 9em;
+  margin: 1em;
+  position: relative;
+}
+.snippet-container > div > span {
+  position: absolute;
+  display: block;
+  background-color: rgba(255,255,255,0.3);
+  padding: 0.2em;
+}
+.snippet-container > div > img {
+  border: 1px solid black;
+}
+
 .github-corner:hover .octo-arm {
   animation: octocat-wave 560ms ease-in-out
 }

reanimate-playground/viewer-elm/src/Main.elm

@@ -14,27 +14,37 @@ import List
 import Platform.Sub
 import Ports
 import Task
-import Time
 import WebSocket
 
 
+type Backend
+    = Production
+    | Local
+
+
+backend : Backend
+backend =
+    Production
+
+
 wsBackend : String
 wsBackend =
-    "wss://reanimate.clozecards.com/ws/"
+    case backend of
+        Production ->
+            "wss://reanimate.clozecards.com/ws/"
 
-
+        Local ->
-
+            "ws://localhost:10161/"
---wsBackend = "ws://localhost:10161/"
 
 
 webBackend : String
 webBackend =
-    "https://reanimate.clozecards.com/"
+    case backend of
+        Production ->
+            "https://reanimate.clozecards.com/"
 
-
+        Local ->
-
+            "http://localhost:10162/"
--- webBackend = "http://localhost:10162/"
--- backend = "localhost"
 
 
 main : Program () Model Msg
@@ -53,8 +63,6 @@ subscriptions model =
         [ Ports.receiveSocketMsg (WebSocket.receive MessageReceived)
         , Ports.receiveEditorMsg Change
         , Ports.receiveControlMsg parseControlMsg
-
-        -- , Keyboard.downs KeyPressed
         , case model of
             Animating { player } ->
                 case player of
@@ -103,8 +111,6 @@ type Msg
     | Pause
     | Play
     | Seek Int
-    | KeyPressed Keyboard.RawKey
-    | ToggleHelp
     | NoOp
     | Change String
 
@@ -123,7 +129,6 @@ type alias Animation =
     , frameIndex : Int
     , player : Player
     , bestFrame : Maybe String
-    , showingHelp : Bool
     , frameDeltas : List Float
     }
 
@@ -135,7 +140,6 @@ initAnimation frameCount =
     , frameIndex = 0
     , player = Playing 0
     , bestFrame = Nothing
-    , showingHelp = False
     , frameDeltas = Fps.init
     }
 
@@ -259,17 +263,11 @@ update msg model =
         MessageReceived result ->
             ( processResult result model, Cmd.none )
 
-        KeyPressed rawKey ->
-            ( model, processKeyPress rawKey model )
-
         Pause ->
             ( updateAnimation (\animation -> { animation | player = Paused }) model
             , blurPlayOrPause
             )
 
-        ToggleHelp ->
-            ( updateAnimation (\animation -> { animation | showingHelp = not animation.showingHelp }) model, Cmd.none )
-
         AttemptReconnect ->
             ( model, connectCommand )
 
@@ -390,19 +388,15 @@ view model =
                     Html.text "Connected"
 
                 Compiling ->
-                    -- TODO it would be nice to have some progress indication (at least animated spinner or something)
+                    -- it would be nice to have some progress indication
+                    -- (at least animated spinner or something)
                     Html.text "Compiling ..."
 
                 Problem problem ->
                     problemView problem
 
-                Animating { frameCount, frames, frameIndex, player, bestFrame, showingHelp, frameDeltas } ->
+                Animating { bestFrame } ->
-                    case player of
+                    frameView bestFrame
-                        Paused ->
-                            frameView bestFrame frameIndex frameCount frames showingHelp frameDeltas True
-
-                        Playing _ ->
-                            frameView bestFrame frameIndex frameCount frames showingHelp frameDeltas False
             ]
         ]
 
@@ -419,32 +413,9 @@ framesPerMillisecond =
     0.03
 
 
-playControls : Bool -> Html Msg
-playControls paused =
-    Html.div [ class "media-controls" ]
-        [ Html.button [ class "button", onClick (Seek -10), disabled (not paused), title "10 frames back" ] [ Html.text "<<" ]
-        , Html.button [ class "button", onClick (Seek -1), disabled (not paused), title "1 frame back" ] [ Html.text "<" ]
-        , if paused then
-            Html.button [ class "button", onClick Play, id playOrPauseId ] [ Html.text "Play" ]
 
-          else
+frameView : Maybe String -> Html Msg
-            Html.button [ class "button", onClick Pause, id playOrPauseId ] [ Html.text "Pause" ]
+frameView bestFrame =
-        , Html.button [ class "button", onClick (Seek 1), disabled (not paused), title "1 frame forward" ] [ Html.text ">" ]
-        , Html.button [ class "button", onClick (Seek 10), disabled (not paused), title "10 frames forward" ] [ Html.text ">>" ]
-        ]
-
-
-mkLink : String -> Html Msg
-mkLink svgUrl =
-    Html.node "link"
-        [ Attr.rel "prefetch"
-        , Attr.href (webBackend ++ svgUrl)
-        ]
-        []
-
-
-frameView : Maybe String -> Int -> Int -> Frames -> Bool -> List Float -> Bool -> Html Msg
-frameView bestFrame frameIndex frameCount frames showingHelp frameDeltas isPaused =
     let
         image =
             case bestFrame of
@@ -453,66 +424,9 @@ frameView bestFrame frameIndex frameCount frames showingHelp frameDeltas isPause
 
                 Nothing ->
                     Html.text ""
-
-        frameCountStr =
-            String.fromInt frameCount
-
-        digitCount =
-            String.length frameCountStr
-
-        progressView =
-            let
-                receivedFrames =
-                    Dict.size frames
-            in
-            if receivedFrames /= frameCount then
-                progressBar receivedFrames frameCount
-
-            else
-                Html.text ""
-
-        helpView =
-            if showingHelp then
-                helpModal
-
-            else
-                Html.button [ class "help-button button", onClick ToggleHelp ] [ Html.text "?" ]
-
-        bar =
-            Html.div [ class "bar" ]
-                [ playControls isPaused
-                , Html.span []
-                    [ Html.text <|
-                        " Frame: "
-                            ++ String.padLeft digitCount '0' (String.fromInt (frameIndex + 1))
-                            ++ " / "
-                            ++ frameCountStr
-
-                    -- ++ (if isPaused then
-                    --         " "
-                    --     else
-                    --         Fps.showAverage frameDeltas
-                    --    )
-                    ]
-                , progressView
-                , helpView
-                ]
     in
     Html.div [ class "viewer" ]
-        [ bar
+        [ image
-        , image
-        ]
-
-
-progressBar : Int -> Int -> Html msg
-progressBar receivedFrames frameCount =
-    Html.label []
-        [ Html.span [] [ Html.text " | Loading frames " ]
-        , Html.progress
-            [ value (String.fromInt receivedFrames)
-            , Attr.max (String.fromInt frameCount)
-            ]
-            []
         ]
 
 
@@ -535,63 +449,3 @@ problemView problem =
 
         UnexpectedMessage problemDescription ->
             Html.text ("Unexpected message: " ++ problemDescription)
-
-
-processKeyPress : RawKey -> Model -> Cmd Msg
-processKeyPress rawKey model =
-    Keyboard.oneOf [ Keyboard.navigationKey, Keyboard.whitespaceKey ] rawKey
-        |> Maybe.andThen
-            (\key ->
-                case key of
-                    Keyboard.ArrowDown ->
-                        Just (Seek -10)
-
-                    Keyboard.ArrowUp ->
-                        Just (Seek 10)
-
-                    Keyboard.ArrowRight ->
-                        Just (Seek 1)
-
-                    Keyboard.ArrowLeft ->
-                        Just (Seek -1)
-
-                    Keyboard.Spacebar ->
-                        case model of
-                            Animating { player } ->
-                                case player of
-                                    Playing _ ->
-                                        Just Pause
-
-                                    Paused ->
-                                        Just Play
-
-                            _ ->
-                                Nothing
-
-                    _ ->
-                        Nothing
-            )
-        |> Maybe.map (Task.succeed >> Task.perform identity)
-        |> Maybe.withDefault Cmd.none
-
-
-helpModal : Html Msg
-helpModal =
-    let
-        explainKey key legend =
-            Html.tr []
-                [ Html.td [] [ Html.b [] [ Html.text key ] ]
-                , Html.td [] [ Html.text legend ]
-                ]
-    in
-    Html.div [ class "help-dialog" ]
-        [ Html.h2 [ style "margin-top" "0px" ] [ Html.text "Keyboard shortcuts" ]
-        , Html.button [ class "help-button button", onClick ToggleHelp ] [ Html.text "X" ]
-        , Html.table []
-            [ explainKey "SPACEBAR" "Pause / Play animation"
-            , explainKey "ARROW LEFT" " Move back 1 frame"
-            , explainKey "ARROW RIGHT" " Move forward 1 frame"
-            , explainKey "ARROW UP" " Move forward 10 frames"
-            , explainKey "ARROW DOWN" " Move back 10 frames"
-            ]
-        ]