Merge development into master

.gitignore

@@ -1,9 +1 @@
-/bower_components/
-/node_modules/
-/.pulp-cache/
-/output/
-/generated-docs/
-/.psc-package/
-/.psc*
-/.purs*
-/.psa*
+.psc-ide-port

.travis.yml

@@ -0,0 +1,4 @@
+language: node_js
+node_js: stable
+script:
+  - scripts/buildandtest.sh

README.md

@@ -1,14 +1,13 @@
-# Statebox Studio
+# Statebox PureScript monorepo
 
-## Try online
+studio demo: [![Netlify Status](https://api.netlify.com/api/v1/badges/8e848ea5-2d7f-4e74-98d7-330a13819bd0/deploy-status)](https://app.netlify.com/sites/statebox-studio-test/deploys).
 
-https://statebox-studio-test.netlify.com/
+source code docs: [![Netlify Status](https://api.netlify.com/api/v1/badges/40809c59-434f-4210-a088-903d2bea5fbf/deploy-status)](https://app.netlify.com/sites/zealous-swirles-adb9a4/deploys)
 
-## Build and run
+monorepo: [![Build Status](https://travis-ci.com/statebox/purescript-studio.svg?token=cVQf36PbhPuPrsV4Ks8k&branch=development)](https://travis-ci.com/statebox/purescript-studio)
 
-Clone and `cd` into the repo, then do:
-```
-npm i
-npm run bundle
-```
-Then open `dist/index.html` in your browser.
+---
+
+This contains Statebox Studio, Statebox REST API, Statebox REST client and associated projects.
+
+See the docs in the [studio](studio/README.md) directory.

halogen-diagram-editor/.gitignore

@@ -0,0 +1,10 @@
+/bower_components/
+/node_modules/
+/.pulp-cache/
+/output/
+/generated-docs/
+/.psc-package/
+/.psc*
+/.purs*
+/.psa*
+/.spago

halogen-diagram-editor/package.json

@@ -0,0 +1,18 @@
+{
+  "name": "purescript-halogen-diagram-editor",
+  "version": "1.0.0",
+  "description": "Halogen brick diagram editor component",
+  "author": "Erik Post <[email protected]>",
+  "main": "index.js",
+  "scripts": {
+    "postinstall": "spago install",
+    "build": "spago build --purs-args --censor-codes=ImplicitImport,ImplicitQualifiedImport,HidingImport",
+    "watch": "spago build --watch --purs-args --censor-codes=ImplicitImport,ImplicitQualifiedImport,HidingImport"
+  },
+  "devDependencies": {
+    "purescript": "^0.13.5",
+    "purescript-psa": "^0.7.3",
+    "spago": "^0.13"
+  },
+  "license": "ISC"
+}

halogen-diagram-editor/spago.dhall

@@ -0,0 +1,11 @@
+{ name =
+    "halogen-diagram-editor"
+, dependencies =
+    [ "vec"
+    , "halogen-svg"
+    ]
+, packages =
+    ../packages.dhall
+, sources =
+    [ "src/**/*.purs", "test/**/*.purs" ]
+}

src/Data/Diagram/FromNLL.purs → halogen-diagram-editor/src/Data/Diagram/FromNLL.purs

@@ -1,4 +1,4 @@
-module View.Diagram.FromNLL (fromNLL, ErrDiagramEncoding(..)) where
+module Data.Diagram.FromNLL (fromNLL, ErrDiagramEncoding(..)) where
 
 import Data.Array hiding (head, tail, length)
 import Data.Array.NonEmpty (toNonEmpty)
@@ -35,15 +35,15 @@ instance showErrDiagramEncoding :: Show ErrDiagramEncoding where
 
 type DiagramM a = Either ErrDiagramEncoding a
 
--- | See https://adoring-curie-7b92fd.netlify.com/.
+-- | See https://adoring-curie-7b92fd.netlify.com and https://docs.statebox.org/spec.
 type BrickDiagram a = 
   { width :: Int
-  , elements :: Array a
+  , pixels :: Array a
   }
 
 -- | Makes a brick diagram without checking bounds and sizes.
 mkBrickDiagramUnsafe :: ∀ a. Int -> Array a -> BrickDiagram a
-mkBrickDiagramUnsafe width ops = { width: width, elements: ops }
+mkBrickDiagramUnsafe width ops = { width: width, pixels: ops }
 
 -- | Safe constructor for brick diagrams, checks that the encoded array has the right size.
 mkBrickDiagram :: ∀ a. Int -> Array a -> DiagramM (BrickDiagram a)
@@ -54,12 +54,12 @@ mkBrickDiagram w ops | length ops `mod` w == 0 = Right $ mkBrickDiagramUnsafe w
 
 -- | Get the height of a brick diagram, assuming it's perfectly rectangular.
 height :: ∀ a. BrickDiagram a -> Int
-height b = (length b.elements) / b.width
+height b = (length b.pixels) / b.width
 
 -- | Return the element below the given coordinates, if any.
 below :: ∀ a. BrickDiagram a -> Int -> Int -> Maybe a
 below b x y = let l = min (height b) (y + 1) in
-                  index b.elements (l * b.width + x)
+                  index b.pixels (l * b.width + x)
 
 -- Converting brick diagrams to directed graphs -----------------------------------------------------------------------
 
@@ -88,11 +88,11 @@ isSelfArrow {source, target} = source == target
 brickToGraph :: ∀ a. Eq a => BrickDiagram a -> Array (GraphArrow a)
 brickToGraph b = mapMaybe (edge b) indices
   where 
-    indices = range 0 (length b.elements - 1)
+    indices = range 0 (length b.pixels - 1)
 
 -- | Given a brick diagram and an index, return one of the arrows leaving the node at this index.
 edge :: ∀ a. Eq a => BrickDiagram a -> Int -> Maybe (GraphArrow a)
-edge b i = { source: _, target: _ } <$> index b.elements i <*> below b xPos yPos
+edge b i = { source: _, target: _ } <$> index b.pixels i <*> below b xPos yPos
   where 
     yPos = i / b.width
     xPos = i `rem` b.width
@@ -142,7 +142,7 @@ type ConsecutiveValues a = { value :: a, length :: Int }
 -- | [--4--]
 -- | ```
 graphToOps :: ∀ a. Eq a => Show a => BrickDiagram a -> Array Operator
-graphToOps { width: width, elements: brick } = 
+graphToOps { width: width, pixels: brick } =
   let lines = splitLines width brick
       l = mapWithIndex mapOperators $ map packConsecutive lines in
       concat l
@@ -170,8 +170,8 @@ nllToBrickDiagram :: Array Int -> DiagramM (BrickDiagram Int)
 nllToBrickDiagram nll = case uncons nll of
   Just { head, tail } -> mkBrickDiagram head tail
   Nothing -> Right $ mkBrickDiagramUnsafe 0 []
-  
-fromNLL :: Array Int -> String -> DiagramM DiagramInfo
-fromNLL nll name = do bricks <- nllToBrickDiagram nll
+
+fromNLL :: String -> Array Int -> DiagramM DiagramInfo
+fromNLL name nll = do bricks <- nllToBrickDiagram nll
                       _ <- parseBrickToGraph 0 bricks
                       Right $ brickToDiagram bricks name

halogen-diagram-editor/src/View/Diagram/Common.purs

@@ -0,0 +1,14 @@
+module View.Diagram.Common where
+
+import Prelude
+import Data.Int (toNumber, round)
+import Halogen.HTML.Properties as HP
+import Halogen.HTML.Core as HC
+
+-- TODO copied from halogen-petrinet-editor.View.Common
+classesWithNames :: ∀ r i. Array String -> HP.IProp (class :: String | r) i
+classesWithNames names = HP.classes (HC.ClassName <$> names)
+
+-- snap s x = x - (x % s)
+snap :: Int -> Int -> Int
+snap s x = s * round (toNumber x / toNumber s) -- s * (x // s)

halogen-diagram-editor/src/View/Diagram/DiagramEditor.purs

@@ -0,0 +1,140 @@
+module View.Diagram.DiagramEditor where
+
+import Prelude hiding (div)
+
+import Data.Array (snoc, length)
+import Data.Maybe (Maybe(..), maybe)
+import Data.Tuple.Nested ((/\))
+import Data.Vec3 (Vec3, vec3, _x, _y, _z)
+import Effect.Aff.Class (class MonadAff)
+import GridKit.KeyHandler
+import Halogen as H
+import Halogen (ComponentHTML, HalogenM)
+import Halogen.HTML (HTML, div, text, button)
+import Halogen.HTML.Core (ClassName(..))
+import Halogen.HTML.Events (onClick)
+import Halogen.HTML.Properties (classes, tabIndex)
+import Unsafe.Coerce (unsafeCoerce)
+import Web.DOM (Element)
+import Web.HTML.HTMLElement (HTMLElement)
+
+import View.ReactiveInput as ReactiveInput
+import View.Diagram.Common (classesWithNames)
+import View.Diagram.Model (DragStart(..), Operators)
+import View.Diagram.Update (Action(..), MouseMsg(..), Msg(..), State, evalModel)
+import View.Diagram.View as View
+import View.Diagram.Inspector as Inspector
+
+initialState :: State
+initialState =
+  { model:
+    { config:        { scale: 24, width: 550, height: 450 }
+    , selectedOpId:  Nothing
+    , mouseOver:     Nothing
+    , mousePos:      vec3 0 0 0
+    , cursorPos:     vec3 0 0 0
+    , mousePressed:  false
+    , dragStart:     DragNotStarted
+    }
+  , msg:                ""
+  , keyHelpVisible:     false
+  , componentElemMaybe: Nothing
+  , inspectorVisible: false
+  }
+
+ui :: ∀ m q. MonadAff m => H.Component HTML q Operators Msg m
+ui = ReactiveInput.mkComponent { initialState, render, handleInput, handleAction }
+  where
+    keys :: KeysWithHelpPopup Action
+    keys = keysWithHelpPopup
+      { keys:        keyHandler [ Shortcut noMods "Space" ] (Just $ text "Insert a new operator") CreateOp <>
+                     cursorKeyHandler noMods MoveCursor
+      , popupAction: ToggleKeyHelp
+      }
+
+    render :: Operators -> State -> ComponentHTML Action () m
+    render ops state =
+      div [ classes [ ClassName "css-diagram-editor" ]
+          , tabIndex 0
+          , keys.onKeyDown
+          ]
+          [ div [ classes [] ]
+                [ View.diagramEditorSVG state.componentElemMaybe ops state.model <#> MouseAction
+                , div [ classes [ ClassName "css-diagram-editor-inspector-container" ] ]
+                      [ div [ classes [ ClassName "css-diagram-editor-inspector-link-container" ] ]
+                            [ button [ onClick \_ -> Just ToggleInspector ]
+                                     [ text $ (if state.inspectorVisible then "Hide" else "Show") <> " inspector" ]
+                            ]
+                      , if state.inspectorVisible
+                           then div [ classesWithNames [ "mt-4", "rb-2", "p-4", "bg-grey-lightest", "text-grey-dark", "rounded", "text-sm" ] ]
+                                    [ Inspector.view ops state ]
+                           else div [] []
+                      ]
+                ]
+          , keys.helpPopup state.keyHelpVisible
+          ]
+
+    handleInput :: Operators -> HalogenM State Action () Msg m Unit
+    handleInput _ = do
+      componentElemMaybe <- getHTMLElementRef' View.componentRefLabel
+      H.modify_ \state -> state { componentElemMaybe = componentElemMaybe }
+
+    handleAction :: Operators -> Action -> HalogenM State Action () Msg m Unit
+    handleAction ops = case _ of
+
+      CreateOp -> do
+        m <- H.get <#> _.model
+        let id = length ops
+        let newOp = { identifier: "new" <> show id, pos: m.cursorPos + vec3 1 0 7, label: "new" <> show id }
+        H.modify_ \st -> st { model = m { cursorPos = m.cursorPos + vec3 0 1 0 } }
+        H.raise $ OperatorsChanged (ops `snoc` newOp)
+
+      MoveCursor delta -> do
+        m <- H.get <#> _.model
+        let { cursorPos, config: { scale, width, height } } = m
+        let cursorPos' = clamp2d (width/scale+1) (height/scale+1) (cursorPos + delta)
+        H.modify_ \st -> st { model = m { cursorPos = cursorPos' } }
+
+      MouseAction msg -> do
+        state <- H.get
+        let (opsChanged /\ model') = evalModel msg ops state.model
+            state' = state { model = model' }
+
+        case opsChanged of
+          Just ops' -> H.raise (OperatorsChanged ops')
+          Nothing -> pure unit
+
+        let isOperatorClicked = case msg of
+              MouseUp _ -> true
+              _         -> false
+
+            clickedOperatorId = case state'.model.mouseOver of
+              Just (op /\ oph) | isOperatorClicked -> Just op.identifier
+              _                                    -> Nothing
+
+            state'' = if isOperatorClicked then state' { model = state'.model { selectedOpId = clickedOperatorId } }
+                                           else state'
+
+        H.put state''
+
+        maybe (pure unit) (H.raise <<< OperatorClicked) clickedOperatorId
+
+      ToggleKeyHelp -> do
+        H.modify_ $ \state -> state { keyHelpVisible = not state.keyHelpVisible }
+
+      ToggleInspector -> do
+        H.modify_ \state -> state { inspectorVisible = not state.inspectorVisible }
+
+--------------------------------------------------------------------------------
+
+clamp2d :: Int -> Int -> Vec3 Int -> Vec3 Int
+clamp2d width height xy = vec3 (clamp 0 (width - 1) (_x xy)) (clamp 0 (height - 1) (_y xy)) (_z xy)
+
+-- TODO this is generally useful; move elsewhere
+-- This was made because the original implementation from Halogen.Query doesn't seem to work, at least in this case:
+--      getHTMLElementRef = map (HTMLElement.fromElement =<< _) <<< getRef
+getHTMLElementRef' :: forall s a i o m. H.RefLabel -> HalogenM s a i o m (Maybe HTMLElement)
+getHTMLElementRef' = map (map elementToHTMLElement) <<< H.getRef
+  where
+    elementToHTMLElement :: Element -> HTMLElement
+    elementToHTMLElement = unsafeCoerce