Skip to content

Commit a09aefc

Browse files
ajnsitajnsit
committed
Initial implementation of the Concur VDom backend
0 parents  commit a09aefc

File tree

10 files changed

+357
-0
lines changed

10 files changed

+357
-0
lines changed

‎.gitignore

+16
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
.DS_Store
2+
npm-debug.log
3+
node_modules/
4+
bower_components/
5+
tmp/
6+
output/
7+
html/index.js
8+
/.psc-package
9+
/.cache
10+
/dist
11+
/.psci_modules
12+
/.spago
13+
/package-lock.json
14+
.spago
15+
.cache
16+
dist

‎LICENSE

+20
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
Copyright (c) 2017-2024 Anupam Jain
2+
3+
Permission is hereby granted, free of charge, to any person obtaining a
4+
copy of this software and associated documentation files (the
5+
"Software"), in the Software without restriction, including without
6+
limitation the rights to use, copy, modify, merge, publish, distribute,
7+
sublicense, and/or sell copies of the Software, and to permit persons to
8+
whom the Software is furnished to do so, subject to the following
9+
conditions:
10+
11+
The above copyright notice and this permission notice shall be included
12+
in all copies or substantial portions of the Software.
13+
14+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
15+
OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
16+
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
17+
IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
18+
CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
19+
TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
20+
SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

‎README.md

+4
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
# Purescript Concur VDom
2+
3+
The Halogen-VDom backend for Concur.
4+

‎index.html

+10
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
<!DOCTYPE html>
2+
<html>
3+
<head>
4+
<meta charset="UTF-8">
5+
<title>Hello Concur VDom!</title>
6+
</head>
7+
<body>
8+
<script src="./index.js" type="module"></script>
9+
</body>
10+
</html>

‎index.js

+2
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
import * as Main from './output/Main/index';
2+
Main.main();

‎package.json

+23
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
{
2+
"name": "purescript-concur-vdom",
3+
"version": "0.1.0",
4+
"description": "Concur UI framework for Purescript, Halogen-VDom backend.",
5+
"license": "MIT",
6+
"repository": "purescript-concur/purescript-concur-vdom",
7+
"author": {
8+
"name": "Anupam Jain",
9+
"email": "ajnsit -at- alphabets email service"
10+
},
11+
"files": [],
12+
"scripts": {
13+
"build": "spago build",
14+
"start": "parcel index.html"
15+
},
16+
"devDependencies": {
17+
"parcel-bundler": "^1.12.5",
18+
"purescript": "^0.15.7",
19+
"purs-tidy": "^0.9.2",
20+
"rimraf": "^3.0.2",
21+
"spago": "^0.20.9"
22+
}
23+
}

‎packages.dhall

+109
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,109 @@
1+
{-
2+
Welcome to your new Dhall package-set!
3+
4+
Below are instructions for how to edit this file for most use
5+
cases, so that you don't need to know Dhall to use it.
6+
7+
## Use Cases
8+
9+
Most will want to do one or both of these options:
10+
1. Override/Patch a package's dependency
11+
2. Add a package not already in the default package set
12+
13+
This file will continue to work whether you use one or both options.
14+
Instructions for each option are explained below.
15+
16+
### Overriding/Patching a package
17+
18+
Purpose:
19+
- Change a package's dependency to a newer/older release than the
20+
default package set's release
21+
- Use your own modified version of some dependency that may
22+
include new API, changed API, removed API by
23+
using your custom git repo of the library rather than
24+
the package set's repo
25+
26+
Syntax:
27+
where `entityName` is one of the following:
28+
- dependencies
29+
- repo
30+
- version
31+
-------------------------------
32+
let upstream = --
33+
in upstream
34+
with packageName.entityName = "new value"
35+
-------------------------------
36+
37+
Example:
38+
-------------------------------
39+
let upstream = --
40+
in upstream
41+
with halogen.version = "master"
42+
with halogen.repo = "https://example.com/path/to/git/repo.git"
43+
44+
with halogen-vdom.version = "v4.0.0"
45+
with halogen-vdom.dependencies = [ "extra-dependency" ] # halogen-vdom.dependencies
46+
-------------------------------
47+
48+
### Additions
49+
50+
Purpose:
51+
- Add packages that aren't already included in the default package set
52+
53+
Syntax:
54+
where `<version>` is:
55+
- a tag (i.e. "v4.0.0")
56+
- a branch (i.e. "master")
57+
- commit hash (i.e. "701f3e44aafb1a6459281714858fadf2c4c2a977")
58+
-------------------------------
59+
let upstream = --
60+
in upstream
61+
with new-package-name =
62+
{ dependencies =
63+
[ "dependency1"
64+
, "dependency2"
65+
]
66+
, repo =
67+
"https://example.com/path/to/git/repo.git"
68+
, version =
69+
"<version>"
70+
}
71+
-------------------------------
72+
73+
Example:
74+
-------------------------------
75+
let upstream = --
76+
in upstream
77+
with benchotron =
78+
{ dependencies =
79+
[ "arrays"
80+
, "exists"
81+
, "profunctor"
82+
, "strings"
83+
, "quickcheck"
84+
, "lcg"
85+
, "transformers"
86+
, "foldable-traversable"
87+
, "exceptions"
88+
, "node-fs"
89+
, "node-buffer"
90+
, "node-readline"
91+
, "datetime"
92+
, "now"
93+
]
94+
, repo =
95+
"https://github.com/hdgarrood/purescript-benchotron.git"
96+
, version =
97+
"v7.0.0"
98+
}
99+
-------------------------------
100+
-}
101+
let upstream =
102+
https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20220725/packages.dhall
103+
sha256:e56fbdf33a5afd2a610c81f8b940b413a638931edb41532164e641bb2a9ec29c
104+
105+
in upstream
106+
107+
with concur-core = ../purescript-concur-core/spago.dhall as Location
108+
with concur-vdom = ./spago.dhall as Location
109+

‎spago.dhall

+24
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
{-
2+
Welcome to a Spago project!
3+
You can edit this file as you like.
4+
-}
5+
{ name = "concur-vdom"
6+
, dependencies =
7+
[ "concur-core"
8+
, "effect"
9+
, "foldable-traversable"
10+
, "halogen-vdom"
11+
, "maybe"
12+
, "newtype"
13+
, "prelude"
14+
, "refs"
15+
, "safe-coerce"
16+
, "web-dom"
17+
, "web-events"
18+
, "web-html"
19+
]
20+
, license = "MIT"
21+
, repository = "https://github.com/purescript-concur/purescript-concur-vdom"
22+
, packages = ./packages.dhall
23+
, sources = [ "src/**/*.purs" ]
24+
}

‎src/Concur/VDom.purs

+123
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,123 @@
1+
module Concur.VDom where
2+
3+
import Concur.Core (Widget, runWidget)
4+
import Concur.Core.DOM as CD
5+
import Concur.Core.LiftWidget (class LiftWidget, liftWidget)
6+
import Concur.Core.Thunk as T
7+
import Concur.Core.Types (display, result)
8+
import Control.Applicative (pure)
9+
import Control.Bind (bind, discard)
10+
import Control.MultiAlternative (class MultiAlternative)
11+
import Control.ShiftMap (class ShiftMap)
12+
import Data.Function (identity, ($))
13+
import Data.Functor (class Functor)
14+
import Data.Maybe (Maybe(..))
15+
import Data.Newtype (class Newtype, un, wrap)
16+
import Data.Traversable (for_)
17+
import Data.Unit (Unit, unit)
18+
import Data.Void (Void, absurd)
19+
import Effect (Effect)
20+
import Effect.Ref (Ref)
21+
import Effect.Ref as Ref
22+
import Effect.Uncurried (runEffectFn1, runEffectFn2)
23+
import Halogen.VDom as V
24+
import Halogen.VDom.DOM.Prop as P
25+
import Halogen.VDom.Machine (Step)
26+
import Halogen.VDom.Types (ElemName(..), VDom(..))
27+
import Safe.Coerce (coerce)
28+
import Web.DOM (Node, Element)
29+
import Web.DOM.Document (Document)
30+
import Web.DOM.Element (toNode)
31+
import Web.DOM.Node (appendChild) as DOM
32+
import Web.DOM.ParentNode (querySelector) as Web
33+
import Web.Event.Event (EventType(..))
34+
import Web.HTML (window) as Web
35+
import Web.HTML.HTMLDocument (toDocument, toParentNode) as Web
36+
import Web.HTML.Window (document) as Web
37+
38+
--------------------------
39+
-- Types
40+
41+
type HTMLProps :: Type -> Type
42+
type HTMLProps a = Array (P.Prop a)
43+
44+
type HTMLBody :: Type -> Type
45+
type HTMLBody a = T.Thunk (HTMLF a)
46+
47+
type HTMLSpec a = V.VDomSpec (HTMLProps a) (HTMLBody a)
48+
type HTMLVDom a = VDom (HTMLProps a) (HTMLBody a)
49+
newtype HTMLF a = HTMLF (HTMLVDom a)
50+
51+
derive instance Functor HTMLF
52+
derive instance Newtype (HTMLF a) _
53+
54+
type HTML1 = HTMLF (Effect Unit)
55+
type HTML = Array HTML1
56+
57+
--------------------------
58+
-- Runners
59+
60+
mkSpec :: Document -> HTMLSpec (Effect Unit)
61+
mkSpec document = V.VDomSpec
62+
{ buildWidget: T.buildThunk (un HTMLF)
63+
, buildAttributes: P.buildProp identity
64+
, document
65+
}
66+
67+
-- To monoidal append views, we just dump them into a container div
68+
unHTML :: HTML -> HTMLVDom (Effect Unit)
69+
unHTML arr = Elem Nothing (coerce "div") [] (coerce arr)
70+
71+
mkHandler
72+
:: Ref (Maybe (Step (HTMLVDom (Effect Unit)) Node))
73+
-> HTMLSpec (Effect Unit)
74+
-> Element
75+
-> HTML
76+
-> Effect Unit
77+
mkHandler machineRef spec body v = do
78+
mmachine <- Ref.read machineRef
79+
machine <- case mmachine of
80+
Just machine -> do
81+
machine' <- runEffectFn2 V.step machine (unHTML v)
82+
Ref.write (Just machine') machineRef
83+
pure machine'
84+
Nothing -> do
85+
machine' <- runEffectFn1 (V.buildVDom spec) (unHTML v)
86+
DOM.appendChild (V.extract machine') (toNode body)
87+
pure machine'
88+
Ref.write (Just machine) machineRef
89+
90+
run :: Widget HTML Void -> Effect Unit
91+
run ww = do
92+
win ← Web.window
93+
doc ← Web.document win
94+
bod ← Web.querySelector (wrap "body") (Web.toParentNode doc)
95+
for_ bod \body → do
96+
machineRef <- Ref.new Nothing
97+
let
98+
spec = mkSpec (Web.toDocument doc)
99+
handler = mkHandler machineRef spec body
100+
runWidget ww $ result handler absurd
101+
102+
------------------------------
103+
-- Constructors
104+
105+
el
106+
:: forall m a
107+
. ShiftMap (Widget HTML) m
108+
=> MultiAlternative m
109+
=> String
110+
-> Array (P.Prop a)
111+
-> Array (m a)
112+
-> m a
113+
el s = CD.el' \a c -> HTMLF (V.Elem Nothing (ElemName s) a (coerce c))
114+
115+
text :: forall m a. LiftWidget HTML m => String -> m a
116+
text s = liftWidget $ display ([ HTMLF (Text s) ] :: HTML)
117+
118+
prop :: forall a. String -> String -> P.Prop a
119+
prop k v = P.Attribute Nothing k v
120+
121+
handle :: String -> P.Prop Unit
122+
handle eventName = P.Handler (EventType eventName) (\_ -> Just unit)
123+

‎src/Main.purs

+26
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
module Main where
2+
3+
import Concur.Core (Widget)
4+
import Concur.Core.VDom (HTML, el, handle, run, text)
5+
import Control.Applicative (pure)
6+
import Control.Bind (discard, (>>=))
7+
import Data.CommutativeRing ((+))
8+
import Data.Semigroup ((<>))
9+
import Data.Show (show)
10+
import Data.Unit (Unit)
11+
import Data.Void (Void)
12+
import Effect (Effect)
13+
14+
counter :: Int -> Widget HTML Int
15+
counter i = do
16+
el "button" [ handle "click" ] [ text ("Count: " <> show i) ]
17+
pure (i + 1)
18+
19+
sample :: Widget HTML Void
20+
sample = go 0
21+
where
22+
go n = counter n >>= go
23+
24+
main :: Effect Unit
25+
main = run sample
26+

0 commit comments

Comments
 (0)