{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

-- | Various SharedRep instances for common html input elements.
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

-- $setup
-- >>> :set -XOverloadedStrings

-- | Create a sharedRep from an Input.
repInput ::
  (Monad m, Show a) =>
  -- | Parser
  (ByteString -> Either ByteString a) ->
  -- | Printer
  (a -> ByteString) ->
  -- | 'Input' type
  Input a ->
  -- | initial value
  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)

-- | 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 :: 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

-- | double slider
--
-- For Example, a slider between 0 and 1 with a step of 0.01 and a default value of 0.3 is:
--
-- > :t slider (Just "label") 0 1 0.01 0.3
-- slider (Just "label") 0 1 0.01 0.3 :: Monad m => SharedRep m Double
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

-- | double slider with shown value
--
-- For Example, a slider between 0 and 1 with a step of 0.01 and a default value of 0.3 is:
--
-- > :t slider (Just "label") 0 1 0.01 0.3
-- slider (Just "label") 0 1 0.01 0.3 :: Monad m => SharedRep m Double
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

-- | integral slider
--
-- For Example, a slider between 0 and 1000 with a step of 10 and a default value of 300 is:
--
-- > :t sliderI (Just "label") 0 1000 10 300
-- 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) =>
  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

-- | integral slider with shown value
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 classique
--
-- > :t textbox (Just "label") "some text"
-- textbox (Just "label") "some text" :: Monad m => SharedRep m ByteString
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 that only updates on focusout
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 input element, specifying number of rows.
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

-- | Non-typed hex color input
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 box
dropdown ::
  (Monad m, Show a) =>
  -- | parse an a from ByteString
  (ByteString -> Either ByteString a) ->
  -- | print an a to ByteString
  (a -> ByteString) ->
  -- | label suggestion
  Maybe ByteString ->
  -- | list of dropbox elements (as text)
  [ByteString] ->
  -- | initial value
  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

-- | dropdown box with multiple selections
dropdownMultiple ::
  (Monad m, Show a) =>
  -- | parse an a from ByteString
  Parser ByteString a ->
  -- | print an a to ByteString
  (a -> ByteString) ->
  -- | label suggestion
  Maybe ByteString ->
  -- | list of dropbox elements (as text)
  [ByteString] ->
  -- | initial value
  [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

-- | a datalist input
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

-- | A dropdown box designed to help represent a haskell sum type.
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

-- | A checkbox input.
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

-- | a toggle button
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

-- | a toggle button, with no label
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

-- | a button
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

-- | filename input
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

-- | Represent a Maybe using a checkbox.
--
-- Hides the underlying content on Nothing
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)
            )
        )

-- | toggle show/hide
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;
}));
|]

-- | A (fixed-size) list represented in html as an accordion card
-- A major restriction of the library is that a 'SharedRep' does not have a Monad instance. In practice, this means that the external representation of lists cannot have a dynamic size.
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)

-- | A (fixed-sized) list of (Bool, a) tuples.
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)

-- | A fixed-sized list of Maybe a\'s
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))

-- | A SharedRep of [a].  Due to the applicative nature of the bridge, the size of lists has to be fixed on construction.  listRep is a workaround for this, to enable some form of dynamic sizing.
listRep ::
  (Monad m) =>
  Maybe ByteString ->
  ByteString ->
  -- | name prefix (should be unique)
  (Bool -> SharedRep m Bool) ->
  -- | Bool Rep
  (a -> SharedRep m a) ->
  -- | a Rep
  Int ->
  -- | maximum length of list
  a ->
  -- | default value for new rows
  [a] ->
  -- | initial values
  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)))

-- a sensible default for the accordion row labels for a list
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]

-- | 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 :: 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)

-- | select test keys from a Map
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

-- | rep of multiple items list
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