web-rep 0.3.0 → 0.3.1
raw patch · 14 files changed
+136/−138 lines, 14 filesdep ~boxdep ~optparse-generic
Dependency ranges changed: box, optparse-generic
Files
- app/example.hs +9/−1
- readme.md +2/−0
- src/Web/Page.hs +7/−4
- src/Web/Page/Bridge.hs +54/−8
- src/Web/Page/Examples.hs +7/−9
- src/Web/Page/Html.hs +1/−1
- src/Web/Page/Html/Input.hs +12/−87
- src/Web/Page/Mathjax.hs +20/−13
- src/Web/Page/Render.hs +0/−2
- src/Web/Page/SharedReps.hs +12/−1
- src/Web/Page/Types.hs +3/−2
- stack.yaml +5/−3
- test/test.hs +1/−1
- web-rep.cabal +3/−6
app/example.hs view
@@ -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) ])
readme.md view
@@ -9,6 +9,8 @@ stack build --test --exec "$(stack path --local-install-root)/bin/page-example --midtype Prod" --file-watch ``` +http://localhost:3000/+ reference ---
src/Web/Page.hs view
@@ -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
src/Web/Page/Bridge.hs view
@@ -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';+ }+ })+ }));+};+|]
src/Web/Page/Examples.hs view
@@ -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
src/Web/Page/Html.hs view
@@ -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
src/Web/Page/Html/Input.hs view
@@ -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';- \}\})- \}));-|]
src/Web/Page/Mathjax.hs view
@@ -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);+ });+ }); }); }); }
src/Web/Page/Render.hs view
@@ -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
@@ -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)
src/Web/Page/Types.hs view
@@ -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
stack.yaml view
@@ -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
test/test.hs view
@@ -84,7 +84,7 @@ describe "Web.Page.Bridge" $ it "bridgePage versus canned" $ toText (renderPage bridgePage) `shouldBe`- "<!DOCTYPE HTML><html lang=\"en\"><head><meta charset=\"utf-8\"></head><body><script>\nwindow.addEventListener('keydown',function(e) {\n if(e.keyIdentifier=='U+000A' || e.keyIdentifier=='Enter' || e.keyCode==13) {\n if(e.target.nodeName=='INPUT' && e.target.type !== 'textarea') {\n e.preventDefault();\n return false;\n }\n }\n}, true);\n\nfunction insertScript ($script) {\n var s = document.createElement('script')\n s.type = 'text/javascript'\n if ($script.src) {\n s.onload = callback\n s.onerror = callback\n s.src = $script.src\n } else {\n s.textContent = $script.innerText\n }\n\n // re-insert the script tag so it executes.\n document.head.appendChild(s)\n\n // clean-up\n $script.parentNode.removeChild($script)\n}\n\nfunction runScripts ($container) {\n // get scripts tags from a node\n var $scripts = $container.querySelectorAll('script')\n $scripts.forEach(function ($script) {\n insertScript($script)\n })\n}\n window.onload=function(){\nwindow.jsb = {ws: new WebSocket('ws://' + location.host + '/')};\njsb.ws.onmessage = (evt) => eval(evt.data);\n};</script></body></html>"+ "<!DOCTYPE HTML><html lang=\"en\"><head><meta charset=\"utf-8\"></head><body><script>\nwindow.addEventListener('keydown',function(e) {\n if(e.keyIdentifier=='U+000A' || e.keyIdentifier=='Enter' || e.keyCode==13) {\n if(e.target.nodeName=='INPUT' && e.target.type !== 'textarea') {\n e.preventDefault();\n return false;\n }\n }\n}, true);\n\nfunction refreshJsb () {\n $('.jsbClassEventChange').off('change');\n $('.jsbClassEventChange').on('change', (function(){\n jsb.event({ 'element': this.id, 'value': this.value});\n }));\n $('.jsbClassEventInput').off('input');\n $('.jsbClassEventInput').on('input', (function(){\n jsb.event({ 'element': this.id, 'value': this.value});\n }));\n $('.jsbClassEventButton').off('click');\n $('.jsbClassEventButton').on('click', (function(){\n jsb.event({ 'element': this.id, 'value': this.value});\n }));\n $('.jsbClassEventToggle').off('click');\n $('.jsbClassEventToggle').on('click', (function(){\n jsb.event({ 'element': this.id, 'value': ('true' !== this.getAttribute('aria-pressed')).toString()});\n }));\n $('.jsbClassEventCheckbox').off('click');\n $('.jsbClassEventCheckbox').on('click', (function(){\n jsb.event({ 'element': this.id, 'value': this.checked.toString()});\n }));\n $('.jsbClassEventChooseFile').off('input');\n $('.jsbClassEventChooseFile').on('input', (function(){\n jsb.event({ 'element': this.id, 'value': this.files[0].name});\n }));\n $('.jsbClassEventShowSum').off('change');\n $('.jsbClassEventShowSum').on('change', (function(){\n var v = this.value;\n $(this).parent('.sumtype-group').siblings('.subtype').each(function(i) {\n if (this.dataset.sumtype === v) {\n this.style.display = 'block';\n } else {\n this.style.display = 'none';\n }\n })\n }));\n};\n window.onload=function(){\nwindow.jsb = {ws: new WebSocket('ws://' + location.host + '/')};\njsb.ws.onmessage = (evt) => eval(evt.data);\n};</script></body></html>" testbs :: [Value] testbs =
web-rep.cabal view
@@ -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,