diff --git a/app/example.hs b/app/example.hs
--- a/app/example.hs
+++ b/app/example.hs
@@ -22,7 +22,6 @@
import Web.Scotty (scotty, middleware)
import qualified Box
import qualified Data.Text as Text
-import Data.Text (pack, Text)
import Control.Monad
import Data.Maybe
@@ -235,4 +234,13 @@
(bool mempty
(toHtml (show initBridgeTest))
(midtype o == Bridge)))
+ ])
+ servePageWith "/log" (defaultPageConfig "prod")
+ (testPage "prod" (pack . show $ midtype o)
+ [ ("input", mempty)
+ , ("output",
+ (bool mempty
+ (toHtml (show initBridgeTest))
+ (midtype o == Bridge)))
+ , ("log", mempty)
])
diff --git a/readme.md b/readme.md
--- a/readme.md
+++ b/readme.md
@@ -9,6 +9,8 @@
stack build --test --exec "$(stack path --local-install-root)/bin/page-example --midtype Prod" --file-watch
```
+http://localhost:3000/
+
reference
---
diff --git a/src/Web/Page.hs b/src/Web/Page.hs
--- a/src/Web/Page.hs
+++ b/src/Web/Page.hs
@@ -28,7 +28,7 @@
PageRender (..),
-- * Css
- Css (..),
+ Css,
PageCss (..),
renderCss,
renderPageCss,
@@ -50,19 +50,22 @@
module Web.Page.Html.Input,
module Web.Page.Bootstrap,
module Web.Page.Mathjax,
+ module Data.Biapplicative,
+ module Data.Bifunctor,
-- * re-exports
module X,
Value (..),
finally,
PixelRGB8 (..),
- HashMap.HashMap (..),
+ HashMap.HashMap,
fromList,
void,
sequenceA_,
Text,
pack,
unpack,
+ toStrict,
bool,
)
where
@@ -73,8 +76,8 @@
import Control.Monad
import Control.Monad.Trans.State as X
import Data.Aeson (Value (..))
-import Data.Biapplicative as X
-import Data.Bifunctor as X
+import Data.Biapplicative
+import Data.Bifunctor
import Data.Bool
import Data.Foldable (sequenceA_)
import qualified Data.HashMap.Strict as HashMap
diff --git a/src/Web/Page/Bridge.hs b/src/Web/Page/Bridge.hs
--- a/src/Web/Page/Bridge.hs
+++ b/src/Web/Page/Bridge.hs
@@ -19,6 +19,8 @@
runList,
runOnEvent,
midShared,
+ refreshJsbJs,
+ runScriptJs,
)
where
@@ -69,7 +71,7 @@
-- | script injection js.
--
--- See https://ghinda.net/article/script-tags/ for why this is needed.
+-- See https://ghinda.net/article/script-tags/ for why this might be needed.
runScriptJs :: PageJs
runScriptJs =
PageJsText
@@ -105,7 +107,7 @@
bridgePage :: Page
bridgePage =
mempty
- & #jsGlobal .~ (preventEnter <> runScriptJs)
+ & #jsGlobal .~ (preventEnter <> refreshJsbJs)
& #jsOnLoad .~ webSocket
sendc :: Engine -> Text -> IO ()
@@ -117,9 +119,9 @@
send e $
command
[qc|
- var $container = document.getElementById('{d}')
- $container.innerHTML = '{clean t}'
- runScripts($container)
+ var $container = document.getElementById('{d}');
+ $container.innerHTML = '{clean t}';
+ refreshJsb();
|]
-- | append to a container and run any embedded scripts
@@ -128,9 +130,9 @@
send e $
command
[qc|
- var $container = document.getElementById('{d}')
- $container.innerHTML += '{clean t}'
- runScripts($container)
+ var $container = document.getElementById('{d}');
+ $container.innerHTML += '{clean t}';
+ refreshJsb();
|]
clean :: Text -> Text
@@ -251,3 +253,47 @@
S.fold
L.list
(sharedModel faStep (\(Element k v) s -> insert k v s) (S.each vs))
+
+-- | Event hooks that may need to be reattached given dynamic content creation.
+refreshJsbJs :: PageJs
+refreshJsbJs =
+ PageJsText
+ [q|
+function refreshJsb () {
+ $('.jsbClassEventChange').off('change');
+ $('.jsbClassEventChange').on('change', (function(){
+ jsb.event({ 'element': this.id, 'value': this.value});
+ }));
+ $('.jsbClassEventInput').off('input');
+ $('.jsbClassEventInput').on('input', (function(){
+ jsb.event({ 'element': this.id, 'value': this.value});
+ }));
+ $('.jsbClassEventButton').off('click');
+ $('.jsbClassEventButton').on('click', (function(){
+ jsb.event({ 'element': this.id, 'value': this.value});
+ }));
+ $('.jsbClassEventToggle').off('click');
+ $('.jsbClassEventToggle').on('click', (function(){
+ jsb.event({ 'element': this.id, 'value': ('true' !== this.getAttribute('aria-pressed')).toString()});
+ }));
+ $('.jsbClassEventCheckbox').off('click');
+ $('.jsbClassEventCheckbox').on('click', (function(){
+ jsb.event({ 'element': this.id, 'value': this.checked.toString()});
+ }));
+ $('.jsbClassEventChooseFile').off('input');
+ $('.jsbClassEventChooseFile').on('input', (function(){
+ jsb.event({ 'element': this.id, 'value': this.files[0].name});
+ }));
+ $('.jsbClassEventShowSum').off('change');
+ $('.jsbClassEventShowSum').on('change', (function(){
+ var v = this.value;
+ $(this).parent('.sumtype-group').siblings('.subtype').each(function(i) {
+ if (this.dataset.sumtype === v) {
+ this.style.display = 'block';
+ } else {
+ this.style.display = 'none';
+ }
+ })
+ }));
+};
+|]
diff --git a/src/Web/Page/Examples.hs b/src/Web/Page/Examples.hs
--- a/src/Web/Page/Examples.hs
+++ b/src/Web/Page/Examples.hs
@@ -55,23 +55,21 @@
$ #libsJs .~ (libJs <$> jsLibsLocal)
$ page1
+-- | simple mathjax formulae
+pagemj :: Page
+pagemj = mathjaxPage & #htmlBody .~ htmlMathjaxExample
+
htmlMathjaxExample :: HtmlT Identity ()
htmlMathjaxExample =
p_ "double dollar:"
<> p_ "$$\\sum_{i=0}^n i^2 = \\frac{(n^2+n)(2n+1)}{6}$$"
- <> p_ "single dollar:"
- <> p_ "$\\sum_{i=0}^n i^2 = \\frac{(n^2+n)(2n+1)}{6}$"
-
--- | simple mathjax formulae
-pagemj :: Page
-pagemj =
- #htmlBody .~ htmlMathjaxExample $
- mathjaxPage
+ <> p_ "single dollar for inline: $\\sum_{i=0}^n i^2 = \\frac{(n^2+n)(2n+1)}{6}$"
+ <> p_ "escaped brackets for inline mathjax: \\(\\sum_{i=0}^n i^2 = \\frac{(n^2+n)(2n+1)}{6}\\)"
-- | simple mathjax formulae inside an svg text element
pagemjsvg :: Page
pagemjsvg =
- (#htmlBody .~ (with Svg.svg11_ [Svg.height_ "400", Svg.width_ "400", Svg.viewBox_ "-20 -20 300 300"]) (with Svg.g_ [class_ "mathjaxsvg"] $ with Svg.text_ [size_ "10"] "inside text element (inside svg):\\(\\sum_{i=0}^n i^2 = \\frac{(n^2+n)(2n+1)}{6}\\)") <> p_ "outside svg:" <> p_ "\\(\\sum_{i=0}^n i^2 = \\frac{(n^2+n)(2n+1)}{6}\\)")
+ (#htmlBody .~ (with Svg.svg11_ [Svg.height_ "400", Svg.width_ "400", Svg.viewBox_ "-20 -20 300 300"]) (with Svg.g_ [class_ "mathjaxsvg"] $ with Svg.text_ [size_ "10", Svg.y_ "100", Svg.x_ "0"] "prefix: $\\sum_{i=0}^n i^2 = \\frac{(n^2+n)(2n+1)}{6}$"))
(mathjaxSvgPage "mathjaxsvg")
cfg2 :: PageConfig
diff --git a/src/Web/Page/Html.hs b/src/Web/Page/Html.hs
--- a/src/Web/Page/Html.hs
+++ b/src/Web/Page/Html.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Key generators and miscellaneous html utilities.
--
@@ -28,7 +29,6 @@
import qualified Data.Text.Lazy as Lazy
import Data.Text.Lazy.Builder (toLazyText)
import Lucid
-import Numeric
import Prelude
-- | FIXME: A horrible hack to separate class id's
diff --git a/src/Web/Page/Html/Input.hs b/src/Web/Page/Html/Input.hs
--- a/src/Web/Page/Html/Input.hs
+++ b/src/Web/Page/Html/Input.hs
@@ -18,7 +18,6 @@
import GHC.Generics
import Lucid
import Lucid.Base
-import Text.InterpolatedString.Perl6
import Web.Page.Html
import Prelude
@@ -60,13 +59,12 @@
( (maybe mempty (with label_ [for_ i] . toHtml) l)
<> input_
( [ type_ "range",
- class__ " form-control-range custom-range",
+ class__ " form-control-range custom-range jsbClassEventChange",
id_ i,
value_ (pack $ show $ toHtml v)
]
<> satts
)
- <> scriptJsbEvent i "change"
)
toHtml (Input v l i TextBox) =
with
@@ -75,12 +73,11 @@
( (maybe mempty (with label_ [for_ i] . toHtml) l)
<> input_
( [ type_ "text",
- class__ "form-control",
+ class__ "form-control jsbClassEventInput",
id_ i,
- value_ (pack $ show $ toHtml v)
+ value_ (pack $ show $ toHtmlRaw v)
]
)
- <> scriptJsbEvent i "input"
)
toHtml (Input v l i (TextArea rows)) =
with
@@ -90,12 +87,11 @@
<> ( with
textarea_
[ rows_ (pack $ show rows),
- class__ "form-control",
+ class__ "form-control jsbClassEventInput",
id_ i
]
(toHtmlRaw v)
)
- <> scriptJsbEvent i "input"
)
toHtml (Input v l i ColorPicker) =
with
@@ -104,12 +100,11 @@
( (maybe mempty (with label_ [for_ i] . toHtml) l)
<> input_
( [ type_ "color",
- class__ "form-control",
+ class__ "form-control jsbClassEventInput",
id_ i,
value_ (pack $ show $ toHtml v)
]
)
- <> scriptJsbEvent i "input"
)
toHtml (Input _ l i ChooseFile) =
with
@@ -118,11 +113,10 @@
(maybe mempty (with label_ [for_ i] . toHtml) l)
<> input_
( [ type_ "file",
- class__ "form-control-file",
+ class__ "form-control-file jsbClassEventChooseFile",
id_ i
]
)
- <> scriptJsbChooseFile i
toHtml (Input v l i (Dropdown opts)) =
with
div_
@@ -130,12 +124,11 @@
( (maybe mempty (with label_ [for_ i] . toHtml) l)
<> ( with
select_
- [ class__ "form-control",
+ [ class__ "form-control jsbClassEventInput",
id_ i
]
opts'
)
- <> scriptJsbEvent i "input"
)
where
opts' =
@@ -158,13 +151,11 @@
( (maybe mempty (with label_ [for_ i] . toHtml) l)
<> ( with
select_
- [ class__ "form-control",
+ [ class__ "form-control jsbClassEventInput jsbClassEventShowSum",
id_ i
]
opts'
)
- <> scriptShowSum i
- <> scriptJsbEvent i "input"
)
where
opts' =
@@ -183,7 +174,7 @@
( (maybe mempty (with label_ [for_ i] . toHtml) l)
<> input_
[ type_ "text",
- class__ "form-control",
+ class__ "form-control jsbClassEventInput",
id_ i,
list_ listId
-- the datalist concept in html assumes initial state is a null
@@ -206,7 +197,6 @@
)
<$> opts
)
- <> scriptJsbEvent i "input"
)
-- FIXME: How can you refactor to eliminate this polymorphic wart?
toHtml (Input _ l i (Checkbox checked)) =
@@ -215,13 +205,12 @@
[class__ "form-check"]
( input_
( [ type_ "checkbox",
- class__ "form-check-input",
+ class__ "form-check-input jsbClassEventCheckbox",
id_ i
]
<> bool [] [checked_] checked
)
<> (maybe mempty (with label_ [for_ i, class__ "form-check-label"] . toHtml) l)
- <> scriptJsbCheckbox i
)
toHtml (Input _ l i (Toggle pushed lab)) =
with
@@ -230,7 +219,7 @@
( (maybe mempty (with label_ [for_ i] . toHtml) l)
<> input_
( [ type_ "button",
- class__ "btn btn-primary btn-sm",
+ class__ "btn btn-primary btn-sm jsbClassEventToggle",
data_ "toggle" "button",
id_ i,
makeAttribute "aria-pressed" (bool "false" "true" pushed)
@@ -238,7 +227,6 @@
<> (maybe [] (\l' -> [value_ l']) lab)
<> bool [] [checked_] pushed
)
- <> scriptJsbToggle i
)
toHtml (Input _ l i Button) =
with
@@ -247,74 +235,11 @@
( input_
( [ type_ "button",
id_ i,
- class__ "btn btn-primary btn-sm",
+ class__ "btn btn-primary btn-sm jsbClassEventButton",
value_ (fromMaybe "button" l)
]
)
- <> scriptJsbButton i
)
toHtmlRaw = toHtml
--- scripts attached to Inputs
--- https://eager.io/blog/everything-I-know-about-the-script-tag/
-
-scriptJsbEvent :: (Monad m) => Text -> Text -> HtmlT m ()
-scriptJsbEvent name event =
- script_
- [qq|
-$('#{name}').on('{event}', (function()\{
- jsb.event(\{ 'element': this.id, 'value': this.value\});
-\}));
-|]
-
-scriptJsbButton :: (Monad m) => Text -> HtmlT m ()
-scriptJsbButton name =
- script_
- [qq|
-$('#{name}').on('click', (function()\{
- jsb.event(\{ 'element': this.id, 'value': this.value\});
-\}));
-|]
-
-scriptJsbToggle :: (Monad m) => Text -> HtmlT m ()
-scriptJsbToggle name =
- script_
- [qq|
-$('#{name}').on('click', (function()\{
- jsb.event(\{ 'element': this.id, 'value': (\"true\" !== this.getAttribute(\"aria-pressed\")).toString()\});
-\}));
-|]
-
-scriptJsbCheckbox :: (Monad m) => Text -> HtmlT m ()
-scriptJsbCheckbox name =
- script_
- [qq|
-$('#{name}').on('click', (function()\{
- jsb.event(\{ 'element': this.id, 'value': this.checked.toString()\});
-\}));
-|]
-
-scriptJsbChooseFile :: (Monad m) => Text -> HtmlT m ()
-scriptJsbChooseFile name =
- script_
- [qq|
-$('#{name}').on('input', (function()\{
- jsb.event(\{ 'element': this.id, 'value': this.files[0].name\});
-\}));
-|]
-
-scriptShowSum :: (Monad m) => Text -> HtmlT m ()
-scriptShowSum name =
- script_
- [qq|
-$('#{name}').on('change', (function()\{
- var v = this.value;
- $(this).parent('.sumtype-group').siblings('.subtype').each(function(i) \{
- if (this.dataset.sumtype === v) \{
- this.style.display = 'block';
- \} else \{
- this.style.display = 'none';
- \}\})
- \}));
-|]
diff --git a/src/Web/Page/Mathjax.hs b/src/Web/Page/Mathjax.hs
--- a/src/Web/Page/Mathjax.hs
+++ b/src/Web/Page/Mathjax.hs
@@ -56,7 +56,7 @@
mathjaxPage :: Page
mathjaxPage =
mempty
- & #jsOnLoad .~ PageJsText scriptMathjaxConfig
+ & #jsGlobal .~ PageJsText scriptMathjaxConfig
& #libsJs
.~ [ mathjax3Lib
]
@@ -90,16 +90,14 @@
jqueryLib
]
+
scriptMathjaxConfig :: Text
scriptMathjaxConfig =
[q|
-{
-MathJax.Hub.Config({
- tex2jax: {
- inlineMath: [ ['$','$'], ["\\(","\\)"] ],
- processEscapes: true
- }
- });
+MathJax = {
+ tex: {
+ inlineMath: [ ['$','$'], ["\\(","\\)"] ]
+ }
};
|]
@@ -134,15 +132,24 @@
-- http://bl.ocks.org/larsenmtl/86077bddc91c3de8d3db6a53216b2f47
scriptMathjaxConfigSvg :: Text -> Text
scriptMathjaxConfigSvg cl =
- [qq| window.MathJax = \{
+ [qq|
+ window.MathJax = \{
+ tex: \{
+ inlineMath: [ ['$','$'], ["\\(","\\)"] ]
+ },
startup: \{
ready: () => \{
MathJax.startup.defaultReady();
MathJax.startup.promise.then(() => \{
- $('.{cl}').each(function()\{
- var m = $('text>mjx-container>svg');
- m.remove();
- $(this).append(m);
+ var xs = document.querySelectorAll('.{cl}');
+ xs.forEach((x) =>
+ \{ x.querySelectorAll('text').forEach((t) =>
+ \{t.querySelectorAll('mjx-container>svg').forEach((s) =>
+ \{
+ Array.from(t.attributes).forEach((a) => s.setAttribute(a.name, a.value));
+ x.appendChild(s);
+ });
+ });
});
});
}
diff --git a/src/Web/Page/Render.hs b/src/Web/Page/Render.hs
--- a/src/Web/Page/Render.hs
+++ b/src/Web/Page/Render.hs
@@ -21,8 +21,6 @@
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.IO (writeFile)
-import Data.Text.Lazy (fromStrict, toStrict)
-import Data.Traversable
import Lucid
import qualified Lucid.Svg as Svg
import Web.Page.Html
diff --git a/src/Web/Page/SharedReps.hs b/src/Web/Page/SharedReps.hs
--- a/src/Web/Page/SharedReps.hs
+++ b/src/Web/Page/SharedReps.hs
@@ -29,6 +29,7 @@
accordionList,
listMaybeRep,
listRep,
+ readTextbox,
defaultListLabels,
)
where
@@ -42,7 +43,7 @@
import Data.Biapplicative
import Data.Bool
import qualified Data.HashMap.Strict as HashMap
-import Data.Text (Text, pack)
+import Data.Text (Text, pack, unpack)
import Lucid
import Text.InterpolatedString.Perl6
import Web.Page.Bootstrap
@@ -371,6 +372,16 @@
-- a sensible default for the accordion row labels for a list
defaultListLabels :: Int -> [Text]
defaultListLabels n = (\x -> "[" <> pack (show x) <> "]") <$> [0 .. n] :: [Text]
+
+-- | Parse from a textbox
+--
+readTextbox :: (Monad m, Read a, Show a) => Maybe Text -> a -> SharedRep m (Either Text a)
+readTextbox label v = parsed . unpack <$> textbox label (pack $ show v)
+ where
+ parsed str =
+ case reads str of
+ [(a, "")] -> Right a
+ _ -> Left (pack str)
-- | Representation of web concerns (css, js & html).
fiddle :: (Monad m) => Concerns Text -> SharedRep m (Concerns Text, Bool)
diff --git a/src/Web/Page/Types.hs b/src/Web/Page/Types.hs
--- a/src/Web/Page/Types.hs
+++ b/src/Web/Page/Types.hs
@@ -6,6 +6,7 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_HADDOCK hide, not-home #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
module Web.Page.Types
( Page (..),
@@ -17,7 +18,7 @@
PageConcerns (..),
PageStructure (..),
PageRender (..),
- Css (..),
+ Css,
PageCss (..),
renderCss,
renderPageCss,
@@ -39,7 +40,7 @@
where
import qualified Clay
-import Clay (Css (..))
+import Clay (Css)
import Control.Applicative
import Control.Lens
import Control.Monad.IO.Class
diff --git a/stack.yaml b/stack.yaml
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,9 +1,11 @@
-resolver: lts-14.13
+resolver: lts-15.6
packages:
-- '.'
+ - '.'
extra-deps:
- lucid-svg-0.7.1
- - box-0.1.0
- javascript-bridge-0.2.0
+ - box-0.3.0
+ - interpolatedstring-perl6-1.0.2
+ - text-format-0.3.2
diff --git a/test/test.hs b/test/test.hs
--- a/test/test.hs
+++ b/test/test.hs
@@ -84,7 +84,7 @@
describe "Web.Page.Bridge" $
it "bridgePage versus canned" $
toText (renderPage bridgePage) `shouldBe`
- ""
+ ""
testbs :: [Value]
testbs =
diff --git a/web-rep.cabal b/web-rep.cabal
--- a/web-rep.cabal
+++ b/web-rep.cabal
@@ -1,6 +1,6 @@
cabal-version: 1.12
name: web-rep
-version: 0.3.0
+version: 0.3.1
synopsis: representations of a web page
category: web
description: An applicative-based, shared-data representation of a web page.
@@ -34,7 +34,7 @@
aeson >= 1.4.5 && < 1.5,
attoparsec >= 0.13.2 && < 0.14,
bifunctors >= 5.5.5 && < 5.6,
- box >= 0.1.0 && < 0.2,
+ box >= 0.1.0 && < 0.3,
clay >= 0.13 && < 0.14,
foldl >= 1.4.5 && < 1.5,
generic-lens >= 1.1.0 && < 1.3,
@@ -46,15 +46,12 @@
lucid-svg >= 0.7.1 && < 0.8,
mmorph >= 1.1.3 && < 1.2,
mtl >= 2.2.2 && < 2.3,
- optparse-generic >= 1.3 && < 1.4,
scotty >= 0.11.5 && < 0.12,
streaming >= 0.2.3 && < 0.3,
text >= 1.2.3 && < 1.3,
text-format >= 0.3.2 && < 0.4,
transformers >= 0.5.6 && < 0.6,
unordered-containers >= 0.2.10 && < 0.3,
- wai >= 3.2.2 && < 3.3,
- wai-extra >= 3.0 && < 3.1,
wai-middleware-static >= 0.8.2 && < 0.9
default-language: Haskell2010
@@ -66,7 +63,7 @@
build-depends:
base >= 4.12 && <5,
attoparsec >= 0.13.2 && < 0.14,
- box >= 0.1.0 && < 0.2,
+ box >= 0.1.0 && < 0.3,
lens >= 4.17 && < 4.19,
lucid >= 2.9 && < 2.10,
optparse-generic >= 1.3.0 && < 1.4,