web-rep 0.12.3.0 → 0.13.0.0
raw patch · 6 files changed
+140/−74 lines, 6 filesdep ~base
Dependency ranges changed: base
Files
- ChangeLog.md +6/−0
- app/rep-example.hs +20/−1
- readme.md +2/−2
- src/Web/Rep/Html/Input.hs +95/−66
- src/Web/Rep/SharedReps.hs +14/−2
- web-rep.cabal +3/−3
ChangeLog.md view
@@ -1,3 +1,9 @@+0.13+===+* added sharedPage+* modified to use modern bootstrap methods++ 0.12.1 === * Changed the order of Page elements, so that inline css over-rides libraries.
app/rep-example.hs view
@@ -64,7 +64,26 @@ (maybeRep (Just "maybe") False repExamples) replaceInput replaceOutput- defaultCodeBoxConfig+ (defaultCodeBoxConfig & set #codeBoxPage sharedPage)++sharedPage :: Page+sharedPage =+ defaultSocketPage+ & set+ #htmlBody+ ( element+ "div"+ [Attr "class" "container"]+ ( element+ "div"+ [Attr "class" "row"]+ (elementc "h1" [] "shared test")+ <> element+ "div"+ [Attr "class" "row"]+ (element "div" [Attr "class" "col-6", Attr "id" "input"] mempty <> element "div" [Attr "class" "col-6", Attr "id" "output"] mempty)+ )+ ) playTest :: IO () playTest = servePlayStream (PlayConfig True 10 0) (defaultCodeBoxConfig & #codeBoxPage .~ playPage) (countStream 100 1)
readme.md view
@@ -10,14 +10,14 @@ # web-rep -[](https://hackage.haskell.org/package/web-rep) [](https://github.com/tonyday567/web-rep/actions?query=workflow%3Ahaskell-ci)+[](https://hackage.haskell.org/package/web-rep) [](https://github.com/tonyday567/web-rep/actions) Various functions and representations for a web page. The best way to understand functionality is via running the example app: cabal install- page-example --apptype SharedTest+ web-rep-example --shared … and then tune in to:
src/Web/Rep/Html/Input.hs view
@@ -42,6 +42,9 @@ instance ToByteString Bool +instance (ToByteString a) => ToByteString [a] where+ toByteString xs = "[" <> C.intercalate "," (fmap toByteString xs) <> "]"+ -- | something that might exist on a web page and be a front-end input to computations. data Input a = Input { -- | underlying value@@ -69,91 +72,95 @@ | DropdownSum [ByteString] | Datalist [ByteString] ByteString | Checkbox Bool- | Toggle Bool (Maybe ByteString)+ | Toggle Bool | Button deriving (Eq, Show, Generic) +label :: AttrValue -> Maybe ByteString -> Markup+label i l = maybe mempty (elementc "label" [Attr "for" i, Attr "class" "col-sm col-form-label"]) l+ -- | 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"]- (maybe mempty (elementc "label" [Attr "for" i, Attr "class" "mb-0"]) l)- <> element_- "input"- ( [ Attr "type" "range",- Attr "class" " form-control-range form-control-sm custom-range jsbClassEventChange",- Attr "id" i,- Attr "value" (pr v)- ]- <> satts- )+ [Attr "class" "row"]+ ( label i l+ <> element_+ "input"+ ( [ Attr "type" "range",+ Attr "class" "col-sm jsbClassEventChange",+ Attr "id" i,+ Attr "value" (pr v)+ ]+ <> satts+ )+ ) markupInput pr (Input v l i (SliderV satts)) = element "div"- [Attr "class" "form-group-sm"]- ( maybe mempty (elementc "label" [Attr "for" i, Attr "class" "mb-0"]) l+ [Attr "class" "row", Attr "style" "align-items: center;"]+ ( label i l <> element_ "input" ( [ Attr "type" "range",- Attr "class" " form-control-range form-control-sm custom-range jsbClassEventChange",+ Attr "class" "col-sm jsbClassEventChange", Attr "id" i, Attr "value" (pr v), Attr "oninput" ("$('#sliderv" <> i <> "').html($(this).val())") ] <> satts )+ <> elementc "span" [Attr "id" ("sliderv" <> i), Attr "class" "col-sm"] (pr v) )- <> elementc "span" [Attr "id" ("sliderv" <> i)] (pr v) markupInput pr (Input v l i TextBox) = element "div"- [Attr "class" "form-group-sm"]- ( maybe mempty (elementc "label" [Attr "for" i, Attr "class" "mb-0"]) l- <> element_- "input"- [ Attr "type" "text",- Attr "class" "form-control form-control-sm jsbClassEventInput",- Attr "id" i,- Attr "value" (pr v)- ]+ [Attr "class" "form-floating"]+ ( element_+ "input"+ [ Attr "type" "text",+ Attr "class" "form-control jsbClassEventInput",+ Attr "id" i,+ Attr "value" (pr v)+ ]+ <> label i l ) markupInput pr (Input v l i TextBox') = element "div"- [Attr "class" "form-group-sm"]- ( maybe mempty (elementc "label" [Attr "for" i, Attr "class" "mb-0"]) l- <> element_- "input"- [ Attr "type" "text",- Attr "class" "form-control form-control-sm jsbClassEventFocusout",- Attr "id" i,- Attr "value" (pr v)- ]+ [Attr "class" "form-floating"]+ ( element_+ "input"+ [ Attr "type" "text",+ Attr "class" "form-control jsbClassEventFocusout",+ Attr "id" i,+ Attr "value" (pr v)+ ]+ <> label i l ) 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" (toByteString rows),- Attr "class" "form-control form-control-sm jsbClassEventInput",- Attr "id" i- ]- (pr v)+ [Attr "class" "form-floating"]+ ( elementc+ "textarea"+ [ Attr "rows" (toByteString rows),+ Attr "class" "form-control jsbClassEventInput",+ Attr "id" i+ ]+ (pr v)+ <> label i l ) markupInput pr (Input v l i ColorPicker) = element "div"- [Attr "class" "form-group-sm"]- ( maybe mempty (elementc "label" [Attr "for" i, Attr "class" "mb-0"]) l+ [Attr "class" "row"]+ ( label i l <> element_ "input" [ Attr "type" "color",- Attr "class" "form-control form-control-sm jsbClassEventInput",+ Attr "class" "form-control jsbClassEventInput", Attr "id" i, Attr "value" (pr v) ]@@ -161,23 +168,23 @@ markupInput _ (Input _ l i ChooseFile) = element "div"- [Attr "class" "form-group-sm"]- ( maybe mempty (elementc "label" [Attr "for" i, Attr "class" "mb-0"]) l+ [Attr "class" "row"]+ ( label i l <> element_ "input" [ Attr "type" "file",- Attr "class" "form-control-file form-control-sm jsbClassEventChooseFile",+ Attr "class" "form-control-file jsbClassEventChooseFile", Attr "id" i ] ) markupInput pr (Input v l i (Dropdown opts)) = element "div"- [Attr "class" "form-group-sm"]- ( maybe mempty (elementc "label" [Attr "for" i, Attr "class" "mb-0"]) l+ [Attr "class" "row"]+ ( label i l <> element "select"- [ Attr "class" "form-control form-control-sm jsbClassEventInput",+ [ Attr "class" "form-control jsbClassEventInput", Attr "id" i ] (mconcat opts')@@ -198,11 +205,11 @@ markupInput pr (Input vs l i (DropdownMultiple opts sep)) = element "div"- [Attr "class" "form-group-sm"]- ( maybe mempty (elementc "label" [Attr "for" i, Attr "class" "mb-0"]) l+ [Attr "class" "row"]+ ( label i l <> element "select"- [ Attr "class" "form-control form-control-sm jsbClassEventChangeMultiple",+ [ Attr "class" "form-control jsbClassEventChangeMultiple", Attr "multiple" "multiple", Attr "id" i ]@@ -224,11 +231,11 @@ markupInput pr (Input v l i (DropdownSum opts)) = element "div"- [Attr "class" "form-group-sm sumtype-group"]- ( maybe mempty (elementc "label" [Attr "for" i, Attr "class" "mb-0"]) l+ [Attr "class" "row sumtype-group"]+ ( label i l <> element "select"- [ Attr "class" "form-control form-control-sm jsbClassEventInput jsbClassEventShowSum",+ [ Attr "class" "form-control jsbClassEventInput jsbClassEventShowSum", Attr "id" i ] (mconcat opts')@@ -245,16 +252,16 @@ markupInput pr (Input v l i (Datalist opts listId)) = element "div"- [Attr "class" "form-group-sm"]- ( maybe mempty (elementc "label" [Attr "for" i, Attr "class" "mb-0"]) l+ [Attr "class" "row"]+ ( label i l <> element_ "input" [ Attr "type" "text",- Attr "class" "form-control form-control-sm jsbClassEventInput",+ Attr "class" "form-control jsbClassEventInput", Attr "id" i, Attr "list" listId -- the datalist concept in html assumes initial state is a null- -- and doesn't present the list if it has a value alreadyx+ -- and doesn't present the list if it has a value already -- , value_ (show $ toHtml v) ] <> element@@ -278,7 +285,7 @@ markupInput _ (Input _ l i (Checkbox checked)) = element "div"- [Attr "class" "form-check form-check-sm"]+ [Attr "class" "form-check"] ( element "input" ( [ Attr "type" "checkbox",@@ -287,9 +294,9 @@ ] <> bool [] [Attr "checked" ""] checked )- (maybe mempty (elementc "label" [Attr "for" i, Attr "class" "form-label-check mb-0"]) l)+ (maybe mempty (elementc "label" [Attr "for" i, Attr "class" "form-check-label"]) l) )-markupInput _ (Input _ l i (Toggle pushed lab)) =+markupInput _ (Input _ l i (Toggle pushed)) = element "div" [Attr "class" "form-group-sm"]@@ -302,7 +309,7 @@ Attr "id" i, Attr "aria-pressed" (bool "false" "true" pushed) ]- <> maybe [] (\l' -> [Attr "value" l']) lab+ <> maybe [] (\l' -> [Attr "value" l']) l <> bool [] [Attr "checked" ""] pushed ) )@@ -318,3 +325,25 @@ Attr "value" (fromMaybe "button" l) ] )++{-+markupInput _ (Input _ l i (Toggle pushed)) =+ maybe mempty (elementc "label" [Attr "for" i, Attr "class" "btn btn-primary"]) l+ <> element_+ "input"+ ( [ Attr "type" "checkbox",+ Attr "class" "btn-check jsbClassEventToggle",+ Attr "autocomplete" "off",+ Attr "id" i+ ]+ <> bool [] [Attr "checked" ""] pushed+ )+markupInput _ (Input _ l i Button) =+ elementc+ "button"+ [ Attr "type" "button",+ Attr "id" i,+ Attr "class" "btn btn-primary jsbClassEventButton"+ ]+ (fromMaybe "button" l)+-}
@@ -30,6 +30,7 @@ listMaybeRep, listRep, readTextbox,+ readTextbox_, defaultListLabels, repChoice, subtype,@@ -281,7 +282,7 @@ repInput (runParserEither ((== "true") <$> takeRest)) (bool "false" "true")- (Input v label mempty (Toggle v label))+ (Input v label mempty (Toggle v)) v -- | a toggle button, with no label@@ -290,7 +291,7 @@ repInput (runParserEither ((== "true") <$> takeRest)) (bool "false" "true")- (Input v Nothing mempty (Toggle v label))+ (Input v label mempty (Toggle v)) v -- | a button@@ -449,6 +450,17 @@ case reads str of [(a, "")] -> Right a _badRead -> Left (strToUtf8 str)++-- | Parse from a textbox+--+-- Uses focusout so as not to spam the reader.+readTextbox_ :: (Monad m, Read a, ToByteString a) => Maybe ByteString -> a -> SharedRep m a+readTextbox_ label v = parsed . utf8ToStr <$> textbox' label (toByteString v)+ where+ parsed str =+ case reads str of+ [(a, "")] -> a+ _badRead -> error "bad read" -- | Dropdown representation of a multi-element list. repChoice :: (Monad m) => Int -> [(ByteString, SharedRep m a)] -> SharedRep m a
web-rep.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: web-rep-version: 0.12.3.0+version: 0.13.0.0 license: BSD-3-Clause license-file: LICENSE copyright: Tony Day (c) 2015@@ -53,7 +53,7 @@ hs-source-dirs: src build-depends: , async >=2.2.4 && <2.3- , base >=4.7 && <5+ , base >=4.14 && <5 , bifunctors >=5.5.11 && <5.7 , box >=0.9 && <0.10 , box-socket >=0.5 && <0.6@@ -92,7 +92,7 @@ main-is: rep-example.hs hs-source-dirs: app build-depends:- , base >=4.7 && <5+ , base >=4.14 && <5 , box >=0.9 && <0.10 , markup-parse >=0.1 && <0.2 , optics-core >=0.4 && <0.5