web-rep 0.11.0.0 → 0.12.0.0
raw patch · 11 files changed
+202/−125 lines, 11 filesdep ~asyncdep ~box-socketdep ~scottyPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: async, box-socket, scotty, text, wai-middleware-static, wai-websockets, websockets
API changes (from Hackage documentation)
- Web.Rep.Examples: listExample :: Monad m => Int -> SharedRep m [Int]
- Web.Rep.Examples: listRepExample :: Monad m => Int -> SharedRep m [Int]
- Web.Rep.Html.Input: inputToHtml :: Show a => Input a -> Markup
+ Web.Rep.Html.Input: class ToByteString a
+ Web.Rep.Html.Input: instance Web.Rep.Html.Input.ToByteString Data.ByteString.Internal.ByteString
+ Web.Rep.Html.Input: instance Web.Rep.Html.Input.ToByteString Data.Text.Internal.Text
+ Web.Rep.Html.Input: instance Web.Rep.Html.Input.ToByteString GHC.Num.Integer.Integer
+ Web.Rep.Html.Input: instance Web.Rep.Html.Input.ToByteString GHC.Types.Bool
+ Web.Rep.Html.Input: instance Web.Rep.Html.Input.ToByteString GHC.Types.Double
+ Web.Rep.Html.Input: instance Web.Rep.Html.Input.ToByteString GHC.Types.Float
+ Web.Rep.Html.Input: instance Web.Rep.Html.Input.ToByteString GHC.Types.Int
+ Web.Rep.Html.Input: markupInput :: (a -> ByteString) -> Input a -> Markup
+ Web.Rep.Html.Input: toByteString :: (ToByteString a, Show a) => a -> ByteString
- Web.Rep.SharedReps: dropdown :: (Monad m, Show a) => (ByteString -> Either ByteString a) -> (a -> ByteString) -> Maybe ByteString -> [ByteString] -> a -> SharedRep m a
+ Web.Rep.SharedReps: dropdown :: Monad m => (ByteString -> Either ByteString a) -> (a -> ByteString) -> Maybe ByteString -> [ByteString] -> a -> SharedRep m a
- Web.Rep.SharedReps: dropdownMultiple :: (Monad m, Show a) => Parser ByteString a -> (a -> ByteString) -> Maybe ByteString -> [ByteString] -> [a] -> SharedRep m [a]
+ Web.Rep.SharedReps: dropdownMultiple :: Monad m => Parser ByteString a -> (a -> ByteString) -> Maybe ByteString -> [ByteString] -> [a] -> SharedRep m [a]
- Web.Rep.SharedReps: dropdownSum :: (Monad m, Show a) => (ByteString -> Either ByteString a) -> (a -> ByteString) -> Maybe ByteString -> [ByteString] -> a -> SharedRep m a
+ Web.Rep.SharedReps: dropdownSum :: Monad m => (ByteString -> Either ByteString a) -> (a -> ByteString) -> Maybe ByteString -> [ByteString] -> a -> SharedRep m a
- Web.Rep.SharedReps: readTextbox :: (Monad m, Read a, Show a) => Maybe ByteString -> a -> SharedRep m (Either ByteString a)
+ Web.Rep.SharedReps: readTextbox :: (Monad m, Read a, ToByteString a) => Maybe ByteString -> a -> SharedRep m (Either ByteString a)
- Web.Rep.SharedReps: repInput :: (Monad m, Show a) => (ByteString -> Either ByteString a) -> (a -> ByteString) -> Input a -> a -> SharedRep m a
+ Web.Rep.SharedReps: repInput :: Monad m => (ByteString -> Either ByteString a) -> (a -> ByteString) -> Input a -> a -> SharedRep m a
- Web.Rep.SharedReps: repMessage :: (Monad m, Show a) => (ByteString -> Either ByteString a) -> (a -> ByteString) -> Input a -> a -> a -> SharedRep m a
+ Web.Rep.SharedReps: repMessage :: Monad m => (ByteString -> Either ByteString a) -> (a -> ByteString) -> Input a -> a -> a -> SharedRep m a
- Web.Rep.SharedReps: sliderI :: (Monad m, Integral a, Show a) => Maybe ByteString -> a -> a -> a -> a -> SharedRep m a
+ Web.Rep.SharedReps: sliderI :: (Monad m, Integral a, ToByteString a) => Maybe ByteString -> a -> a -> a -> a -> SharedRep m a
- Web.Rep.SharedReps: sliderVI :: (Monad m, Integral a, Show a) => Maybe ByteString -> a -> a -> a -> a -> SharedRep m a
+ Web.Rep.SharedReps: sliderVI :: (Monad m, Integral a, ToByteString a) => Maybe ByteString -> a -> a -> a -> a -> SharedRep m a
Files
- ChangeLog.md +7/−0
- readme.org +51/−0
- src/Web/Rep.hs +5/−3
- src/Web/Rep/Bootstrap.hs +3/−0
- src/Web/Rep/Examples.hs +5/−24
- src/Web/Rep/Html/Input.hs +56/−28
- src/Web/Rep/Page.hs +3/−4
- src/Web/Rep/Shared.hs +1/−0
- src/Web/Rep/SharedReps.hs +23/−20
- src/Web/Rep/Socket.hs +36/−36
- web-rep.cabal +12/−10
ChangeLog.md view
@@ -1,3 +1,10 @@+0.12+===++* markupInput replaces inputToHtml as per markup-parse+* ToByteString introduced+* upgrade to box-socket-0.5+ 0.11 === * Removed clay, lucid as dependencies
+ readme.org view
@@ -0,0 +1,51 @@+* web-rep++[[https://hackage.haskell.org/package/numhask-array][file:https://img.shields.io/hackage/v/web-rep.svg]] [[https://github.com/tonyday567/numhask-array/actions?query=workflow%3Ahaskell-ci][file:https://github.com/tonyday567/web-rep/workflows/haskell-ci/badge.svg]]++Various functions and representations for a web page.++The best way to understand functionality is via running the example app:++#+begin_src sh :results output+cabal install+page-example --apptype SharedTest+#+end_src++... and then tune in to:++http://localhost:9160/++* library reference+- [[https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/flags.html#flag-reference][scotty]]+- [[https://getbootstrap.com/][bootstrap]]+- [[https://seiyria.com/bootstrap-slider][bootstrap-slider]]++* Development++#+begin_src elisp+(setq haskell-process-args-cabal-repl '("web-rep:exe:web-rep-example"))+#+end_src++#+RESULTS:+| web-rep:exe:web-rep-example |++#+begin_src haskell :results output :exports both+:r+:set -Wno-type-defaults+:set -Wno-name-shadowing+:set -XOverloadedStrings+:set -XOverloadedLabels+:set -XDataKinds+import Prelude+import Box+import Web.Rep+import Optics.Core+import FlatParse.Basic+import MarkupParse+putStrLn "ok"+#+end_src++#+RESULTS:+: Ok, 11 modules loaded.+: ghci+: ok
src/Web/Rep.hs view
@@ -1,8 +1,10 @@--- | A haskell library for representing web pages.+-- | A haskell library for representing: ----- This library is a collection of web page abstractions, together with a reimagining of <http://hackage.haskell.org/package/suavemente suavemente>.+-- - web pages, as (composable) collections of Html, Css and JS text. ----- I wanted to expose the server delivery mechanism, switch the streaming nature of the gap between a web page and a haskell server, and concentrate on getting a clean interface between pure haskell and the world that is a web page.+-- - things that have a tied together represention in Haskell and in the DOM, where things can have shared sub-components.+--+-- - websocket & server communication protocols. -- -- See app/examples.hs and 'Web.Examples' for usage. module Web.Rep
src/Web/Rep/Bootstrap.hs view
@@ -30,6 +30,7 @@ -- >>> import Web.Rep -- >>> import MarkupParse +-- | bootstrap css link bootstrapCss :: Markup bootstrapCss = element_@@ -40,6 +41,7 @@ Attr "crossorigin" "anonymous" ] +-- | bootstrap JS link bootstrapJs :: Markup bootstrapJs = element_@@ -55,6 +57,7 @@ Attr "crossorigin" "anonymous" ] +-- | bootstrap meta element. bootstrapMeta :: Markup bootstrapMeta = element_ "meta" [Attr "charset" "utf-8"]
src/Web/Rep/Examples.hs view
@@ -4,6 +4,9 @@ {-# LANGUAGE QuasiQuotes #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} +-- | Some simple usage examples to get started with the library.+--+-- The most important example is 'repExamples' which forms the basis of the app example. module Web.Rep.Examples ( page1, page2,@@ -13,8 +16,6 @@ Shape (..), fromShape, toShape,- listExample,- listRepExample, ) where @@ -45,6 +46,7 @@ #libsJs .~ mconcat (libJs <$> jsLibsLocal) $ page1 +-- | Page with separated css and js. cfg2 :: PageConfig cfg2 = #concerns .~ Separated $@@ -144,7 +146,7 @@ repExamples :: (Monad m) => SharedRep m RepExamples repExamples = do t <- textbox (Just "textbox") "sometext"- ta <- textarea 3 (Just "textarea") "no initial value & multi-line text\\nrenders is not ok?/"+ ta <- textarea 3 (Just "textarea") "no initial value & multi-line text" n <- sliderI (Just "int slider") 0 5 1 3 ds' <- slider (Just "double slider") 0 1 0.1 0.5 nV <- sliderVI (Just "int slider") 0 5 1 3@@ -156,24 +158,3 @@ drt <- toShape <$> dropdown (runParserEither takeRest) id (Just "shape") ["Circle", "Square"] (fromShape SquareShape) col <- colorPicker (Just "color") "#454e56" pure (RepExamples t ta n ds' nV dsV' c tog dr drm drt col)--listExample :: (Monad m) => Int -> SharedRep m [Int]-listExample n =- accordionList- (Just "accordianListify")- "al"- Nothing- (\l a -> sliderI (Just l) (0 :: Int) n 1 a)- ((\x -> "[" <> (strToUtf8 . show) x <> "]") <$> [0 .. n] :: [ByteString])- [0 .. n]--listRepExample :: (Monad m) => Int -> SharedRep m [Int]-listRepExample n =- listRep- (Just "listifyMaybe")- "alm"- (checkbox Nothing)- (sliderI Nothing (0 :: Int) n 1)- n- 3- [0 .. 4]
src/Web/Rep/Html/Input.hs view
@@ -1,10 +1,12 @@+{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE OverloadedStrings #-} -- | Common web page input elements, often with bootstrap scaffolding. module Web.Rep.Html.Input ( Input (..), InputType (..),- inputToHtml,+ markupInput,+ ToByteString (..), ) where @@ -12,9 +14,34 @@ import Data.ByteString (ByteString) import Data.ByteString.Char8 qualified as C import Data.Maybe+import Data.Text (Text)+import Data.Text.Encoding import GHC.Generics import MarkupParse +-- | Conversion to a 'ByteString'+class ToByteString a where+ -- | Convert a value to a strict ByteString+ toByteString :: a -> ByteString+ default toByteString :: (Show a) => a -> ByteString+ toByteString = strToUtf8 . show++instance ToByteString ByteString where+ toByteString = id++instance ToByteString Text where+ toByteString = encodeUtf8++instance ToByteString Int++instance ToByteString Integer++instance ToByteString Double++instance ToByteString Float++instance ToByteString Bool+ -- | something that might exist on a web page and be a front-end input to computations. data Input a = Input { -- | underlying value@@ -46,8 +73,9 @@ | Button deriving (Eq, Show, Generic) -inputToHtml :: (Show a) => Input a -> Markup-inputToHtml (Input v l i (Slider satts)) =+-- | Convert an 'Input' to 'Markup' via a specific printer.+markupInput :: (a -> ByteString) -> Input a -> Markup+markupInput pr (Input v l i (Slider satts)) = element "div" [Attr "class" "form-group-sm"]@@ -57,11 +85,11 @@ ( [ Attr "type" "range", Attr "class" " form-control-range form-control-sm custom-range jsbClassEventChange", Attr "id" i,- Attr "value" (strToUtf8 $ show v)+ Attr "value" (pr v) ] <> satts )-inputToHtml (Input v l i (SliderV satts)) =+markupInput pr (Input v l i (SliderV satts)) = element "div" [Attr "class" "form-group-sm"]@@ -71,14 +99,14 @@ ( [ Attr "type" "range", Attr "class" " form-control-range form-control-sm custom-range jsbClassEventChange", Attr "id" i,- Attr "value" (strToUtf8 $ show v),+ Attr "value" (pr v), Attr "oninput" ("$('#sliderv" <> i <> "').html($(this).val())") ] <> satts ) )- <> elementc "span" [Attr "id" ("sliderv" <> i)] (strToUtf8 $ show v)-inputToHtml (Input v l i TextBox) =+ <> elementc "span" [Attr "id" ("sliderv" <> i)] (pr v)+markupInput pr (Input v l i TextBox) = element "div" [Attr "class" "form-group-sm"]@@ -88,10 +116,10 @@ [ Attr "type" "text", Attr "class" "form-control form-control-sm jsbClassEventInput", Attr "id" i,- Attr "value" (strToUtf8 $ show v)+ Attr "value" (pr v) ] )-inputToHtml (Input v l i TextBox') =+markupInput pr (Input v l i TextBox') = element "div" [Attr "class" "form-group-sm"]@@ -101,23 +129,23 @@ [ Attr "type" "text", Attr "class" "form-control form-control-sm jsbClassEventFocusout", Attr "id" i,- Attr "value" (strToUtf8 $ show v)+ Attr "value" (pr v) ] )-inputToHtml (Input v l i (TextArea rows)) =+markupInput pr (Input v l i (TextArea rows)) = element "div" [Attr "class" "form-group-sm"] ( maybe mempty (elementc "label" [Attr "for" i, Attr "class" "mb-0"]) l <> elementc "textarea"- [ Attr "rows" (strToUtf8 $ show rows),+ [ Attr "rows" (toByteString rows), Attr "class" "form-control form-control-sm jsbClassEventInput", Attr "id" i ]- (strToUtf8 $ show v)+ (pr v) )-inputToHtml (Input v l i ColorPicker) =+markupInput pr (Input v l i ColorPicker) = element "div" [Attr "class" "form-group-sm"]@@ -127,10 +155,10 @@ [ Attr "type" "color", Attr "class" "form-control form-control-sm jsbClassEventInput", Attr "id" i,- Attr "value" (strToUtf8 $ show v)+ Attr "value" (pr v) ] )-inputToHtml (Input _ l i ChooseFile) =+markupInput _ (Input _ l i ChooseFile) = element "div" [Attr "class" "form-group-sm"]@@ -142,7 +170,7 @@ Attr "id" i ] )-inputToHtml (Input v l i (Dropdown opts)) =+markupInput pr (Input v l i (Dropdown opts)) = element "div" [Attr "class" "form-group-sm"]@@ -162,12 +190,12 @@ ( bool [] [Attr "selected" "selected"]- (o == strToUtf8 (show v))+ (o == pr v) ) o ) <$> opts-inputToHtml (Input vs l i (DropdownMultiple opts sep)) =+markupInput pr (Input vs l i (DropdownMultiple opts sep)) = element "div" [Attr "class" "form-group-sm"]@@ -188,12 +216,12 @@ ( bool [] [Attr "selected" "selected"]- (any (\v -> o == strToUtf8 (show v)) (C.split sep (strToUtf8 $ show vs)))+ (any (\v -> o == strToUtf8 (show v)) (C.split sep (pr vs))) ) o ) <$> opts-inputToHtml (Input v l i (DropdownSum opts)) =+markupInput pr (Input v l i (DropdownSum opts)) = element "div" [Attr "class" "form-group-sm sumtype-group"]@@ -210,11 +238,11 @@ ( \o -> elementc "option"- (bool [] [Attr "selected" "selected"] (o == strToUtf8 (show v)))+ (bool [] [Attr "selected" "selected"] (o == pr v)) o ) <$> opts-inputToHtml (Input v l i (Datalist opts listId)) =+markupInput pr (Input v l i (Datalist opts listId)) = element "div" [Attr "class" "form-group-sm"]@@ -239,7 +267,7 @@ ( bool [] [Attr "selected" "selected"]- (o == strToUtf8 (show v))+ (o == pr v) ) o )@@ -247,7 +275,7 @@ ) ) )-inputToHtml (Input _ l i (Checkbox checked)) =+markupInput _ (Input _ l i (Checkbox checked)) = element "div" [Attr "class" "form-check form-check-sm"]@@ -262,7 +290,7 @@ ( maybe mempty (elementc "label" [Attr "for" i, Attr "class" "form-label-check mb-0"]) l ) )-inputToHtml (Input _ l i (Toggle pushed lab)) =+markupInput _ (Input _ l i (Toggle pushed lab)) = element "div" [Attr "class" "form-group-sm"]@@ -279,7 +307,7 @@ <> bool [] [Attr "checked" ""] pushed ) )-inputToHtml (Input _ l i Button) =+markupInput _ (Input _ l i Button) = element "div" [Attr "class" "form-group-sm"]
src/Web/Rep/Page.hs view
@@ -3,9 +3,9 @@ {-# LANGUAGE QuasiQuotes #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +-- | Representations of a web page, covering Html, CSS & JS artifacts. module Web.Rep.Page- ( -- $page- Page (..),+ ( Page (..), PageConfig (..), defaultPageConfig, Concerns (..),@@ -13,10 +13,8 @@ concernNames, PageConcerns (..), PageStructure (..),- -- $css Css (..), renderCss,- -- $js Js (..), onLoad, )@@ -137,5 +135,6 @@ -- | Javascript as string newtype Js = Js {jsByteString :: ByteString} deriving (Eq, Show, Generic, Semigroup, Monoid) +-- | Add the windows.onload assignment onLoad :: Js -> Js onLoad (Js t) = Js [i| window.onload=function(){#{t}};|]
@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} +-- | A shared-element representation of web page communication. module Web.Rep.Shared ( RepF (..), Rep,
@@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# OPTIONS_GHC -Wno-name-shadowing #-}+{-# OPTIONS_GHC -Wno-x-partial #-} -- | Various SharedRep instances for common html input elements. module Web.Rep.SharedReps@@ -62,7 +63,7 @@ -- | Create a sharedRep from an Input. repInput ::- (Monad m, Show a) =>+ (Monad m) => -- | Parser (ByteString -> Either ByteString a) -> -- | Printer@@ -72,12 +73,12 @@ -- | initial value a -> SharedRep m a-repInput p pr i = register p pr (\n v -> inputToHtml $ #inputVal .~ v $ #inputId .~ n $ i)+repInput p pr i = register p pr (\n v -> markupInput pr $ #inputVal .~ v $ #inputId .~ n $ i) -- | Like 'repInput', but does not put a value into the HashMap on instantiation, consumes the value when found in the HashMap, and substitutes a default on lookup failure-repMessage :: (Monad m, Show a) => (ByteString -> Either ByteString a) -> (a -> ByteString) -> Input a -> a -> a -> SharedRep m a-repMessage p _ i def a =- message p (\n v -> inputToHtml $ #inputVal .~ v $ #inputId .~ n $ i) a def+repMessage :: (Monad m) => (ByteString -> Either ByteString a) -> (a -> ByteString) -> Input a -> a -> a -> SharedRep m a+repMessage p pr i def a =+ message p (\n v -> markupInput pr $ #inputVal .~ v $ #inputId .~ n $ i) a def -- | double slider --@@ -129,7 +130,7 @@ -- sliderI (Just "label") 0 1000 10 300 -- :: (Monad m, ToHtml a, P.Integral a, Show a) => SharedRep m a sliderI ::- (Monad m, P.Integral a, Show a) =>+ (Monad m, P.Integral a, ToByteString a) => Maybe ByteString -> a -> a ->@@ -139,13 +140,13 @@ sliderI label l u s v = repInput (runParserEither (fromIntegral <$> int))- (strToUtf8 . show)- (Input v label mempty (Slider [Attr "min" (strToUtf8 $ show l), Attr "max" (strToUtf8 $ show u), Attr "step" (strToUtf8 $ show s)]))+ toByteString+ (Input v label mempty (Slider [Attr "min" (toByteString l), Attr "max" (toByteString u), Attr "step" (toByteString s)])) v -- | integral slider with shown value sliderVI ::- (Monad m, P.Integral a, Show a) =>+ (Monad m, P.Integral a, ToByteString a) => Maybe ByteString -> a -> a ->@@ -155,8 +156,8 @@ sliderVI label l u s v = repInput (runParserEither (fromIntegral <$> int))- (strToUtf8 . show)- (Input v label mempty (SliderV [Attr "min" (strToUtf8 $ show l), Attr "max" (strToUtf8 $ show u), Attr "step" (strToUtf8 $ show s)]))+ toByteString+ (Input v label mempty (SliderV [Attr "min" (toByteString l), Attr "max" (toByteString u), Attr "step" (toByteString s)])) v -- | textbox classique@@ -200,7 +201,7 @@ -- | dropdown box dropdown ::- (Monad m, Show a) =>+ (Monad m) => -- | parse an a from ByteString (ByteString -> Either ByteString a) -> -- | print an a to ByteString@@ -221,7 +222,7 @@ -- | dropdown box with multiple selections dropdownMultiple ::- (Monad m, Show a) =>+ (Monad m) => -- | parse an a from ByteString Parser ByteString a -> -- | print an a to ByteString@@ -251,7 +252,7 @@ -- | A dropdown box designed to help represent a haskell sum type. dropdownSum ::- (Monad m, Show a) =>+ (Monad m) => (ByteString -> Either ByteString a) -> (a -> ByteString) -> Maybe ByteString ->@@ -347,7 +348,7 @@ zoom _2 (modify (HashMap.insert name (bool "false" "true" v))) pure $ Rep- (inputToHtml (Input v label name (Checkbox v)) <> scriptToggleShow name id')+ (markupInput (strToUtf8 . show) (Input v label name (Checkbox v)) <> scriptToggleShow name id') ( \s -> ( s, join $@@ -395,9 +396,9 @@ . zipWith (\l (ch, a) -> (l, a, ch)) labels ) ( foldr- (\a x -> bimap (:) (:) a <<*>> x)+ ((\a x -> bimap (:) (:) a <<*>> x) . (\(ch, a) -> bimap (,) (,) (checkf ch) <<*>> bodyf a)) (pure [])- ((\(ch, a) -> bimap (,) (,) (checkf ch) <<*>> bodyf a) <$> xs)+ xs ) h' <- zoom _1 h pure (Rep (maybe mempty (elementc "h5" []) title <> h') fa)@@ -434,21 +435,22 @@ (defaultListLabels n) (take n (((True,) <$> as) <> repeat (False, defa))) --- a sensible default for the accordion row labels for a list+-- | A sensible default for the accordion row labels for a list defaultListLabels :: Int -> [ByteString] defaultListLabels n = (\x -> "[" <> strToUtf8 (show x) <> "]") <$> [0 .. n] :: [ByteString] -- | Parse from a textbox -- -- Uses focusout so as not to spam the reader.-readTextbox :: (Monad m, Read a, Show a) => Maybe ByteString -> a -> SharedRep m (Either ByteString a)-readTextbox label v = parsed . utf8ToStr <$> textbox' label (strToUtf8 $ show v)+readTextbox :: (Monad m, Read a, ToByteString a) => Maybe ByteString -> a -> SharedRep m (Either ByteString a)+readTextbox label v = parsed . utf8ToStr <$> textbox' label (toByteString v) where parsed str = case reads str of [(a, "")] -> Right a _badRead -> Left (strToUtf8 str) +-- | Dropdown representation of a multi-element list. repChoice :: (Monad m) => Int -> [(ByteString, SharedRep m a)] -> SharedRep m a repChoice initt xs = bimap hmap mmap dd@@ -477,6 +479,7 @@ repItemsSelect initial full = dropdownMultiple (strToUtf8 <$> some (satisfy (`notElem` ([','] :: [Char])))) id (Just "items") full initial +-- | subtype Html class. subtype :: ByteString -> ByteString -> [Attr] subtype origt t = [ Attr "class" "subtype ",
src/Web/Rep/Socket.hs view
@@ -43,7 +43,7 @@ where import Box-import Box.Socket (serverApp)+import Box.Websocket (serverApp) import Control.Concurrent.Async import Control.Monad import Control.Monad.State.Lazy@@ -55,7 +55,7 @@ import Data.Profunctor import Data.String.Interpolate import Data.Text (Text)-import Data.Text qualified as Text+import Data.Text.Encoding import FlatParse.Basic import GHC.Generics import MarkupParse@@ -70,51 +70,46 @@ import Web.Rep.SharedReps import Web.Scotty (middleware, scotty) -toText_ :: ByteString -> Text-toText_ = Text.pack . utf8ToStr--fromText_ :: Text -> ByteString-fromText_ = strToUtf8 . Text.unpack- -- | Page with all the trimmings for a sharedRep Box socketPage :: Page socketPage = mempty & #jsOnLoad- .~ mconcat- [ webSocket,- runScriptJs,- refreshJsbJs,- preventEnter- ]+ .~ mconcat+ [ webSocket,+ runScriptJs,+ refreshJsbJs,+ preventEnter+ ] +-- | Bootstrapped base page for a web socket. defaultSocketPage :: Page defaultSocketPage = bootstrapPage <> socketPage- & set- #htmlBody- ( element- "div"- [Attr "class" "container"]- ( element- "div"- [Attr "class" "row"]- (elementc "h1" [] "web-rep testing")- <> element+ & set+ #htmlBody+ ( element+ "div"+ [Attr "class" "container"]+ ( element "div" [Attr "class" "row"]- ( mconcat $- ( \(t, h) ->- element- "div"- [Attr "class" "row"]- (element "h2" [] (elementc "div" [Attr "id" t] h))- )- <$> sections- )- )- )+ (elementc "h1" [] "web-rep testing")+ <> element+ "div"+ [Attr "class" "row"]+ ( mconcat $+ ( \(t, h) ->+ element+ "div"+ [Attr "class" "row"]+ (element "h2" [] (elementc "div" [Attr "id" t] h))+ )+ <$> sections+ )+ )+ ) where sections = [ ("input", mempty),@@ -169,7 +164,7 @@ (view #codeBoxEmitterQueue cfg) (view #codeBoxCommitterQueue cfg) ( serveSocketBox (view #codeBoxSocket cfg) (view #codeBoxPage cfg)- . dimap (either error id . runParserEither parserJ . fromText_) (mconcat . fmap (toText_ . code))+ . dimap (either error id . runParserEither parserJ . encodeUtf8) (mconcat . fmap (decodeUtf8 . code)) ) -- | Turn the default configuration into a live (Codensity) CodeBox@@ -293,6 +288,7 @@ -- * code messaging +-- | A simple schema for code that communicates changes to a Html page via JS code. data Code = Replace ByteString ByteString | Append ByteString ByteString@@ -301,6 +297,7 @@ | Val ByteString deriving (Eq, Show, Generic, Read) +-- | Convert 'Code' to a 'ByteString' code :: Code -> ByteString code (Replace i t) = replace i t code (Append i t) = append i t@@ -308,9 +305,11 @@ code (Eval t) = t code (Val t) = val t +-- | write to the console console :: ByteString -> ByteString console t = [i| console.log(#{t}) |] +-- | send arbitrary byestrings. val :: ByteString -> ByteString val t = [i| jsb.ws.send(#{t}) |] @@ -334,6 +333,7 @@ refreshJsb(); |] +-- | Double backslash newline and single quotes. clean :: ByteString -> ByteString clean = C.intercalate "\\'"
web-rep.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: web-rep-version: 0.11.0.0+version: 0.12.0.0 license: BSD-3-Clause license-file: LICENSE copyright: Tony Day (c) 2015@@ -14,8 +14,10 @@ An applicative-based, shared-data representation of a web page. build-type: Simple-tested-with: GHC == 8.10.7 || ==9.2.8 || ==9.4.5 || ==9.6.2-extra-doc-files: ChangeLog.md+tested-with: GHC == 8.10.7 || ==9.2.7 || ==9.4.7 || ==9.6.3 || ==9.8.1+extra-doc-files:+ ChangeLog.md+ readme.org source-repository head type: git@@ -100,11 +102,11 @@ import: ghc2021-stanza hs-source-dirs: src build-depends:- , async ^>=2.2.4+ , async >=2.2.4 && <2.3 , base >=4.7 && <5 , bifunctors >=5.5.11 && <5.7 , box >=0.9 && <0.10- , box-socket >=0.4 && <0.5+ , box-socket >=0.5 && <0.6 , bytestring >=0.11.3 && <0.13 , flatparse >=0.3.5 && <0.6 , markup-parse >=0.1.0.1 && <0.2@@ -112,14 +114,14 @@ , optics-core >=0.4 && <0.5 , optics-extra >=0.4 && <0.5 , profunctors >=5.6.2 && <5.7- , scotty >=0.11.5 && <0.13+ , scotty >=0.11.5 && <0.22 , string-interpolate >=0.3 && <0.4- , text >=1.2 && <2.1+ , text >=1.2 && <2.2 , transformers >=0.5.6 && <0.6.2 , unordered-containers >=0.2 && <0.3- , wai-middleware-static ^>=0.9- , wai-websockets ^>=3.0.1.2- , websockets ^>=0.12+ , wai-middleware-static >=0.9 && <0.10+ , wai-websockets >=3.0.1.2 && <3.1+ , websockets >=0.12 && <0.13 exposed-modules: Web.Rep Web.Rep.Bootstrap