{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Web.Rep.SharedReps
( repInput,
repMessage,
sliderI,
slider,
sliderV,
sliderVI,
dropdown,
dropdownMultiple,
datalist,
dropdownSum,
colorPicker,
textbox,
textarea,
checkbox,
toggle,
toggle_,
button,
chooseFile,
maybeRep,
accordionList,
listMaybeRep,
listRep,
readTextbox,
defaultListLabels,
repChoice,
subtype,
selectItems,
repItemsSelect,
)
where
import Box.Codensity ()
import Control.Monad
import Control.Monad.State.Lazy
import Data.Biapplicative
import Data.Bool
import Data.ByteString (ByteString, intercalate)
import Data.HashMap.Strict qualified as HashMap
import Data.List qualified as List
import Data.Maybe
import Data.String.Interpolate
import FlatParse.Basic hiding (take)
import MarkupParse
import MarkupParse.FlatParse
import Optics.Core hiding (element)
import Optics.Zoom
import Web.Rep.Bootstrap
import Web.Rep.Html.Input
import Web.Rep.Shared
import Prelude as P
repInput ::
(Monad m, Show a) =>
(ByteString -> Either ByteString a) ->
(a -> ByteString) ->
Input a ->
a ->
SharedRep m a
repInput :: forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput AttrName -> Either AttrName a
p a -> AttrName
pr Input a
i = forall (m :: * -> *) a r.
Monad m =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> (AttrName -> a -> r) -> a -> SharedRepF m r a
register AttrName -> Either AttrName a
p a -> AttrName
pr (\AttrName
n a
v -> forall a. Show a => Input a -> Markup
inputToHtml forall a b. (a -> b) -> a -> b
$ forall a. IsLabel "inputVal" a => a
#inputVal forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ a
v forall a b. (a -> b) -> a -> b
$ forall a. IsLabel "inputId" a => a
#inputId forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ AttrName
n forall a b. (a -> b) -> a -> b
$ Input a
i)
repMessage :: (Monad m, Show a) => (ByteString -> Either ByteString a) -> (a -> ByteString) -> Input a -> a -> a -> SharedRep m a
repMessage :: forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> a -> SharedRep m a
repMessage AttrName -> Either AttrName a
p a -> AttrName
_ Input a
i a
def a
a =
forall (m :: * -> *) a r.
Monad m =>
(AttrName -> Either AttrName a)
-> (AttrName -> a -> r) -> a -> a -> SharedRepF m r a
message AttrName -> Either AttrName a
p (\AttrName
n a
v -> forall a. Show a => Input a -> Markup
inputToHtml forall a b. (a -> b) -> a -> b
$ forall a. IsLabel "inputVal" a => a
#inputVal forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ a
v forall a b. (a -> b) -> a -> b
$ forall a. IsLabel "inputId" a => a
#inputId forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ AttrName
n forall a b. (a -> b) -> a -> b
$ Input a
i) a
a a
def
slider ::
(Monad m) =>
Maybe ByteString ->
Double ->
Double ->
Double ->
Double ->
SharedRep m Double
slider :: forall (m :: * -> *).
Monad m =>
Maybe AttrName
-> Double -> Double -> Double -> Double -> SharedRep m Double
slider Maybe AttrName
label Double
l Double
u Double
s Double
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither forall e. Parser e Double
double)
(String -> AttrName
strToUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input Double
v Maybe AttrName
label forall a. Monoid a => a
mempty ([Attr] -> InputType
Slider [AttrName -> AttrName -> Attr
Attr AttrName
"min" (String -> AttrName
strToUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
l), AttrName -> AttrName -> Attr
Attr AttrName
"max" (String -> AttrName
strToUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
u), AttrName -> AttrName -> Attr
Attr AttrName
"step" (String -> AttrName
strToUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
s)]))
Double
v
sliderV ::
(Monad m) =>
Maybe ByteString ->
Double ->
Double ->
Double ->
Double ->
SharedRep m Double
sliderV :: forall (m :: * -> *).
Monad m =>
Maybe AttrName
-> Double -> Double -> Double -> Double -> SharedRep m Double
sliderV Maybe AttrName
label Double
l Double
u Double
s Double
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither forall e. Parser e Double
double)
(String -> AttrName
strToUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input Double
v Maybe AttrName
label forall a. Monoid a => a
mempty ([Attr] -> InputType
SliderV [AttrName -> AttrName -> Attr
Attr AttrName
"min" (String -> AttrName
strToUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
l), AttrName -> AttrName -> Attr
Attr AttrName
"max" (String -> AttrName
strToUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
u), AttrName -> AttrName -> Attr
Attr AttrName
"step" (String -> AttrName
strToUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
s)]))
Double
v
sliderI ::
(Monad m, P.Integral a, Show a) =>
Maybe ByteString ->
a ->
a ->
a ->
a ->
SharedRep m a
sliderI :: forall (m :: * -> *) a.
(Monad m, Integral a, Show a) =>
Maybe AttrName -> a -> a -> a -> a -> SharedRep m a
sliderI Maybe AttrName
label a
l a
u a
s a
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Parser e Int
int))
(String -> AttrName
strToUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input a
v Maybe AttrName
label forall a. Monoid a => a
mempty ([Attr] -> InputType
Slider [AttrName -> AttrName -> Attr
Attr AttrName
"min" (String -> AttrName
strToUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
l), AttrName -> AttrName -> Attr
Attr AttrName
"max" (String -> AttrName
strToUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
u), AttrName -> AttrName -> Attr
Attr AttrName
"step" (String -> AttrName
strToUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
s)]))
a
v
sliderVI ::
(Monad m, P.Integral a, Show a) =>
Maybe ByteString ->
a ->
a ->
a ->
a ->
SharedRep m a
sliderVI :: forall (m :: * -> *) a.
(Monad m, Integral a, Show a) =>
Maybe AttrName -> a -> a -> a -> a -> SharedRep m a
sliderVI Maybe AttrName
label a
l a
u a
s a
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Parser e Int
int))
(String -> AttrName
strToUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input a
v Maybe AttrName
label forall a. Monoid a => a
mempty ([Attr] -> InputType
SliderV [AttrName -> AttrName -> Attr
Attr AttrName
"min" (String -> AttrName
strToUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
l), AttrName -> AttrName -> Attr
Attr AttrName
"max" (String -> AttrName
strToUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
u), AttrName -> AttrName -> Attr
Attr AttrName
"step" (String -> AttrName
strToUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
s)]))
a
v
textbox :: (Monad m) => Maybe ByteString -> ByteString -> SharedRep m ByteString
textbox :: forall (m :: * -> *).
Monad m =>
Maybe AttrName -> AttrName -> SharedRep m AttrName
textbox Maybe AttrName
label AttrName
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither forall (st :: ZeroBitType) e. ParserT st e AttrName
takeRest)
forall a. a -> a
id
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input AttrName
v Maybe AttrName
label forall a. Monoid a => a
mempty InputType
TextBox)
AttrName
v
textbox' :: (Monad m) => Maybe ByteString -> ByteString -> SharedRep m ByteString
textbox' :: forall (m :: * -> *).
Monad m =>
Maybe AttrName -> AttrName -> SharedRep m AttrName
textbox' Maybe AttrName
label AttrName
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither forall (st :: ZeroBitType) e. ParserT st e AttrName
takeRest)
forall a. a -> a
id
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input AttrName
v Maybe AttrName
label forall a. Monoid a => a
mempty InputType
TextBox')
AttrName
v
textarea :: (Monad m) => Int -> Maybe ByteString -> ByteString -> SharedRep m ByteString
textarea :: forall (m :: * -> *).
Monad m =>
Int -> Maybe AttrName -> AttrName -> SharedRep m AttrName
textarea Int
rows Maybe AttrName
label AttrName
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither forall (st :: ZeroBitType) e. ParserT st e AttrName
takeRest)
forall a. a -> a
id
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input AttrName
v Maybe AttrName
label forall a. Monoid a => a
mempty (Int -> InputType
TextArea Int
rows))
AttrName
v
colorPicker :: (Monad m) => Maybe ByteString -> ByteString -> SharedRep m ByteString
colorPicker :: forall (m :: * -> *).
Monad m =>
Maybe AttrName -> AttrName -> SharedRep m AttrName
colorPicker Maybe AttrName
label AttrName
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither forall (st :: ZeroBitType) e. ParserT st e AttrName
takeRest)
forall a. a -> a
id
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input AttrName
v Maybe AttrName
label forall a. Monoid a => a
mempty InputType
ColorPicker)
AttrName
v
dropdown ::
(Monad m, Show a) =>
(ByteString -> Either ByteString a) ->
(a -> ByteString) ->
Maybe ByteString ->
[ByteString] ->
a ->
SharedRep m a
dropdown :: forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName)
-> Maybe AttrName
-> [AttrName]
-> a
-> SharedRep m a
dropdown AttrName -> Either AttrName a
p a -> AttrName
pr Maybe AttrName
label [AttrName]
opts a
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
AttrName -> Either AttrName a
p
a -> AttrName
pr
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input a
v Maybe AttrName
label forall a. Monoid a => a
mempty ([AttrName] -> InputType
Dropdown [AttrName]
opts))
a
v
dropdownMultiple ::
(Monad m, Show a) =>
Parser ByteString a ->
(a -> ByteString) ->
Maybe ByteString ->
[ByteString] ->
[a] ->
SharedRep m [a]
dropdownMultiple :: forall (m :: * -> *) a.
(Monad m, Show a) =>
Parser AttrName a
-> (a -> AttrName)
-> Maybe AttrName
-> [AttrName]
-> [a]
-> SharedRep m [a]
dropdownMultiple Parser AttrName a
p a -> AttrName
pr Maybe AttrName
label [AttrName]
opts [a]
vs =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither (forall e s a. Parser e s -> Parser e a -> Parser e [a]
sep forall e. Parser e ()
comma Parser AttrName a
p))
(AttrName -> [AttrName] -> AttrName
intercalate AttrName
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> AttrName
pr)
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input [a]
vs Maybe AttrName
label forall a. Monoid a => a
mempty ([AttrName] -> Char -> InputType
DropdownMultiple [AttrName]
opts Char
','))
[a]
vs
datalist :: (Monad m) => Maybe ByteString -> [ByteString] -> ByteString -> ByteString -> SharedRep m ByteString
datalist :: forall (m :: * -> *).
Monad m =>
Maybe AttrName
-> [AttrName] -> AttrName -> AttrName -> SharedRep m AttrName
datalist Maybe AttrName
label [AttrName]
opts AttrName
v AttrName
id'' =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither forall (st :: ZeroBitType) e. ParserT st e AttrName
takeRest)
(String -> AttrName
strToUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input AttrName
v Maybe AttrName
label forall a. Monoid a => a
mempty ([AttrName] -> AttrName -> InputType
Datalist [AttrName]
opts AttrName
id''))
AttrName
v
dropdownSum ::
(Monad m, Show a) =>
(ByteString -> Either ByteString a) ->
(a -> ByteString) ->
Maybe ByteString ->
[ByteString] ->
a ->
SharedRep m a
dropdownSum :: forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName)
-> Maybe AttrName
-> [AttrName]
-> a
-> SharedRep m a
dropdownSum AttrName -> Either AttrName a
p a -> AttrName
pr Maybe AttrName
label [AttrName]
opts a
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
AttrName -> Either AttrName a
p
a -> AttrName
pr
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input a
v Maybe AttrName
label forall a. Monoid a => a
mempty ([AttrName] -> InputType
DropdownSum [AttrName]
opts))
a
v
checkbox :: (Monad m) => Maybe ByteString -> Bool -> SharedRep m Bool
checkbox :: forall (m :: * -> *).
Monad m =>
Maybe AttrName -> Bool -> SharedRep m Bool
checkbox Maybe AttrName
label Bool
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither ((forall a. Eq a => a -> a -> Bool
== AttrName
"true") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (st :: ZeroBitType) e. ParserT st e AttrName
takeRest))
(forall a. a -> a -> Bool -> a
bool AttrName
"false" AttrName
"true")
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input Bool
v Maybe AttrName
label forall a. Monoid a => a
mempty (Bool -> InputType
Checkbox Bool
v))
Bool
v
toggle :: (Monad m) => Maybe ByteString -> Bool -> SharedRep m Bool
toggle :: forall (m :: * -> *).
Monad m =>
Maybe AttrName -> Bool -> SharedRep m Bool
toggle Maybe AttrName
label Bool
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither ((forall a. Eq a => a -> a -> Bool
== AttrName
"true") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (st :: ZeroBitType) e. ParserT st e AttrName
takeRest))
(forall a. a -> a -> Bool -> a
bool AttrName
"false" AttrName
"true")
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input Bool
v Maybe AttrName
label forall a. Monoid a => a
mempty (Bool -> Maybe AttrName -> InputType
Toggle Bool
v Maybe AttrName
label))
Bool
v
toggle_ :: (Monad m) => Maybe ByteString -> Bool -> SharedRep m Bool
toggle_ :: forall (m :: * -> *).
Monad m =>
Maybe AttrName -> Bool -> SharedRep m Bool
toggle_ Maybe AttrName
label Bool
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither ((forall a. Eq a => a -> a -> Bool
== AttrName
"true") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (st :: ZeroBitType) e. ParserT st e AttrName
takeRest))
(forall a. a -> a -> Bool -> a
bool AttrName
"false" AttrName
"true")
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input Bool
v forall a. Maybe a
Nothing forall a. Monoid a => a
mempty (Bool -> Maybe AttrName -> InputType
Toggle Bool
v Maybe AttrName
label))
Bool
v
button :: (Monad m) => Maybe ByteString -> SharedRep m Bool
button :: forall (m :: * -> *). Monad m => Maybe AttrName -> SharedRep m Bool
button Maybe AttrName
label =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> a -> SharedRep m a
repMessage
(forall a b. a -> b -> a
const (forall a b. b -> Either a b
Right Bool
True))
(forall a. a -> a -> Bool -> a
bool AttrName
"false" AttrName
"true")
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input Bool
False Maybe AttrName
label forall a. Monoid a => a
mempty InputType
Button)
Bool
False
Bool
False
chooseFile :: (Monad m) => Maybe ByteString -> ByteString -> SharedRep m ByteString
chooseFile :: forall (m :: * -> *).
Monad m =>
Maybe AttrName -> AttrName -> SharedRep m AttrName
chooseFile Maybe AttrName
label AttrName
v =
forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName) -> Input a -> a -> SharedRep m a
repInput
(forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither forall (st :: ZeroBitType) e. ParserT st e AttrName
takeRest)
(String -> AttrName
strToUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
(forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input AttrName
v Maybe AttrName
label forall a. Monoid a => a
mempty InputType
ChooseFile)
AttrName
v
maybeRep ::
(Monad m) =>
Maybe ByteString ->
Bool ->
SharedRep m a ->
SharedRep m (Maybe a)
maybeRep :: forall (m :: * -> *) a.
Monad m =>
Maybe AttrName -> Bool -> SharedRep m a -> SharedRep m (Maybe a)
maybeRep Maybe AttrName
label Bool
st SharedRep m a
sa = forall (m :: * -> *) r a.
StateT (Int, HashMap AttrName AttrName) m (RepF r a)
-> SharedRepF m r a
SharedRep forall a b. (a -> b) -> a -> b
$ do
AttrName
id' <- forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall s t a b. Field1 s t a b => Lens s t a b
_1 (forall (m :: * -> *). MonadState Int m => AttrName -> m AttrName
genNamePre AttrName
"maybe")
forall (m :: * -> *) r a.
SharedRepF m r a
-> StateT (Int, HashMap AttrName AttrName) m (RepF r a)
unshare forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (AttrName -> Markup -> Markup -> Markup
hmap AttrName
id') forall {a}. Bool -> a -> Maybe a
mmap (forall (m :: * -> *).
Monad m =>
Maybe AttrName -> AttrName -> Bool -> SharedRep m Bool
checkboxShow Maybe AttrName
label AttrName
id' Bool
st) forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> SharedRep m a
sa
where
hmap :: AttrName -> Markup -> Markup -> Markup
hmap AttrName
id' Markup
a Markup
b =
(Markup, [Attr]) -> Maybe AttrName -> (Markup, [Attr]) -> Markup
cardify
(Markup
a, [])
forall a. Maybe a
Nothing
( AttrName -> [Attr] -> Markup -> Markup
element
AttrName
"div"
[ AttrName -> AttrName -> Attr
Attr AttrName
"id" AttrName
id',
AttrName -> AttrName -> Attr
Attr
AttrName
"style"
(AttrName
"display:" forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool AttrName
"none" AttrName
"block" Bool
st)
]
Markup
b,
[AttrName -> AttrName -> Attr
Attr AttrName
"style" AttrName
"padding-top: 0.25rem; padding-bottom: 0.25rem;"]
)
mmap :: Bool -> a -> Maybe a
mmap Bool
a a
b = forall a. a -> a -> Bool -> a
bool forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just a
b) Bool
a
checkboxShow :: (Monad m) => Maybe ByteString -> ByteString -> Bool -> SharedRep m Bool
checkboxShow :: forall (m :: * -> *).
Monad m =>
Maybe AttrName -> AttrName -> Bool -> SharedRep m Bool
checkboxShow Maybe AttrName
label AttrName
id' Bool
v =
forall (m :: * -> *) r a.
StateT (Int, HashMap AttrName AttrName) m (RepF r a)
-> SharedRepF m r a
SharedRep forall a b. (a -> b) -> a -> b
$ do
AttrName
name <- forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall s t a b. Field1 s t a b => Lens s t a b
_1 forall (m :: * -> *). MonadState Int m => m AttrName
genName
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall s t a b. Field2 s t a b => Lens s t a b
_2 (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert AttrName
name (forall a. a -> a -> Bool -> a
bool AttrName
"false" AttrName
"true" Bool
v)))
pure $
forall r a.
r
-> (HashMap AttrName AttrName
-> (HashMap AttrName AttrName, Either AttrName a))
-> RepF r a
Rep
(forall a. Show a => Input a -> Markup
inputToHtml (forall a. a -> Maybe AttrName -> AttrName -> InputType -> Input a
Input Bool
v Maybe AttrName
label AttrName
name (Bool -> InputType
Checkbox Bool
v)) forall a. Semigroup a => a -> a -> a
<> AttrName -> AttrName -> Markup
scriptToggleShow AttrName
name AttrName
id')
( \HashMap AttrName AttrName
s ->
( HashMap AttrName AttrName
s,
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall a b. a -> Either a b
Left AttrName
"HashMap.lookup failed")
(forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> AttrName
strToUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither ((forall a. Eq a => a -> a -> Bool
== AttrName
"true") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (st :: ZeroBitType) e. ParserT st e AttrName
takeRest))
(forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup AttrName
name HashMap AttrName AttrName
s)
)
)
scriptToggleShow :: ByteString -> ByteString -> Markup
scriptToggleShow :: AttrName -> AttrName -> Markup
scriptToggleShow AttrName
checkName AttrName
toggleId =
AttrName -> [Attr] -> AttrName -> Markup
elementc
AttrName
"script"
[]
[i|
$('\##{checkName}').on('change', (function(){
var vis = this.checked ? "block" : "none";
document.getElementById("#{toggleId}").style.display = vis;
}));
|]
accordionList :: (Monad m) => Maybe ByteString -> ByteString -> Maybe ByteString -> (ByteString -> a -> SharedRep m a) -> [ByteString] -> [a] -> SharedRep m [a]
accordionList :: forall (m :: * -> *) a.
Monad m =>
Maybe AttrName
-> AttrName
-> Maybe AttrName
-> (AttrName -> a -> SharedRep m a)
-> [AttrName]
-> [a]
-> SharedRep m [a]
accordionList Maybe AttrName
title AttrName
prefix Maybe AttrName
open AttrName -> a -> SharedRep m a
srf [AttrName]
labels [a]
as = forall (m :: * -> *) r a.
StateT (Int, HashMap AttrName AttrName) m (RepF r a)
-> SharedRepF m r a
SharedRep forall a b. (a -> b) -> a -> b
$ do
(Rep StateT Int m Markup
h HashMap AttrName AttrName
-> (HashMap AttrName AttrName, Either AttrName [a])
fa) <-
forall (m :: * -> *) r a.
SharedRepF m r a
-> StateT (Int, HashMap AttrName AttrName) m (RepF r a)
unshare forall a b. (a -> b) -> a -> b
$
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall (m :: * -> *).
MonadState Int m =>
AttrName -> Maybe AttrName -> [(AttrName, Markup)] -> m Markup
accordion AttrName
prefix Maybe AttrName
open forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [AttrName]
labels) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\SharedRep m a
a SharedRepF m [Markup] [a]
x -> forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (:) (:) SharedRep m a
a forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> SharedRepF m [Markup] [a]
x)
(forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
(forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith AttrName -> a -> SharedRep m a
srf [AttrName]
labels [a]
as)
Markup
h' <- forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall s t a b. Field1 s t a b => Lens s t a b
_1 StateT Int m Markup
h
pure (forall r a.
r
-> (HashMap AttrName AttrName
-> (HashMap AttrName AttrName, Either AttrName a))
-> RepF r a
Rep (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (AttrName -> [Attr] -> AttrName -> Markup
elementc AttrName
"h5" []) Maybe AttrName
title forall a. Semigroup a => a -> a -> a
<> Markup
h') HashMap AttrName AttrName
-> (HashMap AttrName AttrName, Either AttrName [a])
fa)
accordionBoolList :: (Monad m) => Maybe ByteString -> ByteString -> (a -> SharedRep m a) -> (Bool -> SharedRep m Bool) -> [ByteString] -> [(Bool, a)] -> SharedRep m [(Bool, a)]
accordionBoolList :: forall (m :: * -> *) a.
Monad m =>
Maybe AttrName
-> AttrName
-> (a -> SharedRep m a)
-> (Bool -> SharedRep m Bool)
-> [AttrName]
-> [(Bool, a)]
-> SharedRep m [(Bool, a)]
accordionBoolList Maybe AttrName
title AttrName
prefix a -> SharedRep m a
bodyf Bool -> SharedRep m Bool
checkf [AttrName]
labels [(Bool, a)]
xs = forall (m :: * -> *) r a.
StateT (Int, HashMap AttrName AttrName) m (RepF r a)
-> SharedRepF m r a
SharedRep forall a b. (a -> b) -> a -> b
$ do
(Rep StateT Int m Markup
h HashMap AttrName AttrName
-> (HashMap AttrName AttrName, Either AttrName [(Bool, a)])
fa) <-
forall (m :: * -> *) r a.
SharedRepF m r a
-> StateT (Int, HashMap AttrName AttrName) m (RepF r a)
unshare forall a b. (a -> b) -> a -> b
$
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
( forall (m :: * -> *).
MonadState Int m =>
AttrName -> [(AttrName, Markup, Markup)] -> m Markup
accordionChecked AttrName
prefix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\AttrName
l (Markup
ch, Markup
a) -> (AttrName
l, Markup
a, Markup
ch)) [AttrName]
labels
)
( forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\SharedRepF m (Markup, Markup) (Bool, a)
a SharedRepF m [(Markup, Markup)] [(Bool, a)]
x -> forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (:) (:) SharedRepF m (Markup, Markup) (Bool, a)
a forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> SharedRepF m [(Markup, Markup)] [(Bool, a)]
x)
(forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
((\(Bool
ch, a
a) -> forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (,) (,) (Bool -> SharedRep m Bool
checkf Bool
ch) forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> a -> SharedRep m a
bodyf a
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Bool, a)]
xs)
)
Markup
h' <- forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom forall s t a b. Field1 s t a b => Lens s t a b
_1 StateT Int m Markup
h
pure (forall r a.
r
-> (HashMap AttrName AttrName
-> (HashMap AttrName AttrName, Either AttrName a))
-> RepF r a
Rep (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (AttrName -> [Attr] -> AttrName -> Markup
elementc AttrName
"h5" []) Maybe AttrName
title forall a. Semigroup a => a -> a -> a
<> Markup
h') HashMap AttrName AttrName
-> (HashMap AttrName AttrName, Either AttrName [(Bool, a)])
fa)
listMaybeRep :: (Monad m) => Maybe ByteString -> ByteString -> (ByteString -> Maybe a -> SharedRep m (Maybe a)) -> Int -> [a] -> SharedRep m [Maybe a]
listMaybeRep :: forall (m :: * -> *) a.
Monad m =>
Maybe AttrName
-> AttrName
-> (AttrName -> Maybe a -> SharedRep m (Maybe a))
-> Int
-> [a]
-> SharedRep m [Maybe a]
listMaybeRep Maybe AttrName
t AttrName
p AttrName -> Maybe a -> SharedRep m (Maybe a)
srf Int
n [a]
as =
forall (m :: * -> *) a.
Monad m =>
Maybe AttrName
-> AttrName
-> Maybe AttrName
-> (AttrName -> a -> SharedRep m a)
-> [AttrName]
-> [a]
-> SharedRep m [a]
accordionList Maybe AttrName
t AttrName
p forall a. Maybe a
Nothing AttrName -> Maybe a -> SharedRep m (Maybe a)
srf (Int -> [AttrName]
defaultListLabels Int
n) (forall a. Int -> [a] -> [a]
take Int
n ((forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as) forall a. Semigroup a => a -> a -> a
<> forall a. a -> [a]
repeat forall a. Maybe a
Nothing))
listRep ::
(Monad m) =>
Maybe ByteString ->
ByteString ->
(Bool -> SharedRep m Bool) ->
(a -> SharedRep m a) ->
Int ->
a ->
[a] ->
SharedRep m [a]
listRep :: forall (m :: * -> *) a.
Monad m =>
Maybe AttrName
-> AttrName
-> (Bool -> SharedRep m Bool)
-> (a -> SharedRep m a)
-> Int
-> a
-> [a]
-> SharedRep m [a]
listRep Maybe AttrName
t AttrName
p Bool -> SharedRep m Bool
brf a -> SharedRep m a
srf Int
n a
defa [a]
as =
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Bool
b, a
a) -> forall a. a -> a -> Bool -> a
bool [] [a
a] Bool
b)) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a.
Monad m =>
Maybe AttrName
-> AttrName
-> (a -> SharedRep m a)
-> (Bool -> SharedRep m Bool)
-> [AttrName]
-> [(Bool, a)]
-> SharedRep m [(Bool, a)]
accordionBoolList
Maybe AttrName
t
AttrName
p
a -> SharedRep m a
srf
Bool -> SharedRep m Bool
brf
(Int -> [AttrName]
defaultListLabels Int
n)
(forall a. Int -> [a] -> [a]
take Int
n (((Bool
True,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as) forall a. Semigroup a => a -> a -> a
<> forall a. a -> [a]
repeat (Bool
False, a
defa)))
defaultListLabels :: Int -> [ByteString]
defaultListLabels :: Int -> [AttrName]
defaultListLabels Int
n = (\Int
x -> AttrName
"[" forall a. Semigroup a => a -> a -> a
<> String -> AttrName
strToUtf8 (forall a. Show a => a -> String
show Int
x) forall a. Semigroup a => a -> a -> a
<> AttrName
"]") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. Int
n] :: [ByteString]
readTextbox :: (Monad m, Read a, Show a) => Maybe ByteString -> a -> SharedRep m (Either ByteString a)
readTextbox :: forall (m :: * -> *) a.
(Monad m, Read a, Show a) =>
Maybe AttrName -> a -> SharedRep m (Either AttrName a)
readTextbox Maybe AttrName
label a
v = forall {b}. Read b => String -> Either AttrName b
parsed forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> String
utf8ToStr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
Maybe AttrName -> AttrName -> SharedRep m AttrName
textbox' Maybe AttrName
label (String -> AttrName
strToUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
v)
where
parsed :: String -> Either AttrName b
parsed String
str =
case forall a. Read a => ReadS a
reads String
str of
[(b
a, String
"")] -> forall a b. b -> Either a b
Right b
a
[(b, String)]
_badRead -> forall a b. a -> Either a b
Left (String -> AttrName
strToUtf8 String
str)
repChoice :: (Monad m) => Int -> [(ByteString, SharedRep m a)] -> SharedRep m a
repChoice :: forall (m :: * -> *) a.
Monad m =>
Int -> [(AttrName, SharedRep m a)] -> SharedRep m a
repChoice Int
initt [(AttrName, SharedRep m a)]
xs =
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Markup -> [Markup] -> Markup
hmap forall {b}. AttrName -> [b] -> b
mmap SharedRep m AttrName
dd
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\SharedRep m a
x SharedRepF m [Markup] [a]
a -> forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (:) (:) SharedRep m a
x forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> SharedRepF m [Markup] [a]
a) (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) [SharedRep m a]
cs
where
ts :: [AttrName]
ts = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(AttrName, SharedRep m a)]
xs
cs :: [SharedRep m a]
cs = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(AttrName, SharedRep m a)]
xs
dd :: SharedRep m AttrName
dd = forall (m :: * -> *) a.
(Monad m, Show a) =>
(AttrName -> Either AttrName a)
-> (a -> AttrName)
-> Maybe AttrName
-> [AttrName]
-> a
-> SharedRep m a
dropdownSum (forall e a. IsString e => Parser e a -> AttrName -> Either e a
runParserEither forall (st :: ZeroBitType) e. ParserT st e AttrName
takeRest) forall a. a -> a
id forall a. Maybe a
Nothing [AttrName]
ts AttrName
t0
t0 :: AttrName
t0 = [AttrName]
ts forall a. [a] -> Int -> a
List.!! Int
initt
hmap :: Markup -> [Markup] -> Markup
hmap Markup
dd' [Markup]
cs' =
AttrName -> [Attr] -> Markup -> Markup
element
AttrName
"div"
[]
( Markup
dd' forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (AttrName -> AttrName -> Markup -> Markup
addSubtype AttrName
t0) [AttrName]
ts [Markup]
cs')
)
mmap :: AttrName -> [b] -> b
mmap AttrName
dd' [b]
cs' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. [a] -> a
List.head [b]
cs') ([b]
cs' List.!!) (forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex AttrName
dd' [AttrName]
ts)
selectItems :: [ByteString] -> HashMap.HashMap ByteString a -> [(ByteString, a)]
selectItems :: forall a. [AttrName] -> HashMap AttrName a -> [(AttrName, a)]
selectItems [AttrName]
ks HashMap AttrName a
m =
forall k v. HashMap k v -> [(k, v)]
HashMap.toList forall a b. (a -> b) -> a -> b
$
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey (\AttrName
k a
_ -> AttrName
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AttrName]
ks) HashMap AttrName a
m
repItemsSelect :: (Monad m) => [ByteString] -> [ByteString] -> SharedRep m [ByteString]
repItemsSelect :: forall (m :: * -> *).
Monad m =>
[AttrName] -> [AttrName] -> SharedRep m [AttrName]
repItemsSelect [AttrName]
initial [AttrName]
full =
forall (m :: * -> *) a.
(Monad m, Show a) =>
Parser AttrName a
-> (a -> AttrName)
-> Maybe AttrName
-> [AttrName]
-> [a]
-> SharedRep m [a]
dropdownMultiple (String -> AttrName
strToUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ([Char
','] :: [Char])))) forall a. a -> a
id (forall a. a -> Maybe a
Just AttrName
"items") [AttrName]
full [AttrName]
initial
subtype :: ByteString -> ByteString -> [Attr]
subtype :: AttrName -> AttrName -> [Attr]
subtype AttrName
origt AttrName
t =
[ AttrName -> AttrName -> Attr
Attr AttrName
"class" AttrName
"subtype ",
AttrName -> AttrName -> Attr
Attr AttrName
"data_sumtype" AttrName
t,
AttrName -> AttrName -> Attr
Attr AttrName
"style" (AttrName
"display:" forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool AttrName
"block" AttrName
"none" (AttrName
origt forall a. Eq a => a -> a -> Bool
/= AttrName
t))
]
addSubtype :: ByteString -> ByteString -> Markup -> Markup
addSubtype :: AttrName -> AttrName -> Markup -> Markup
addSubtype AttrName
origt AttrName
t (Markup [Element]
trees) =
[Element] -> Markup
Markup forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Token
toke -> forall a. a -> Maybe a -> a
fromMaybe Token
toke forall a b. (a -> b) -> a -> b
$ [Attr] -> Token -> Maybe Token
addAttrs (AttrName -> AttrName -> [Attr]
subtype AttrName
origt AttrName
t) Token
toke)) [Element]
trees