packages feed

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 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}};|]
src/Web/Rep/Shared.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} +-- | A shared-element representation of web page communication. module Web.Rep.Shared   ( RepF (..),     Rep,
src/Web/Rep/SharedReps.hs view
@@ -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