{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}

-- | 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,
    fiddle,
    viaFiddle,
    accordionList,
    listMaybeRep,
    listRep,
    readTextbox,
    defaultListLabels,
    repChoice,
    subtype,
    selectItems,
    repItemsSelect,
  )
where

import Box.Codensity ()
import Control.Monad
import Control.Monad.State.Lazy
import Data.Attoparsec.Text hiding (take)
import qualified Data.Attoparsec.Text as A
import Data.Biapplicative
import Data.Bool
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List as List
import Data.Text (Text, intercalate, pack, unpack)
import Lucid
import Optics.Core
import Optics.Zoom
import Text.InterpolatedString.Perl6
import Web.Rep.Bootstrap
import Web.Rep.Html
import Web.Rep.Html.Input
import Web.Rep.Page
import Web.Rep.Shared
import Prelude as P

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

-- | Create a sharedRep from an Input.
repInput ::
  (Monad m, ToHtml a) =>
  -- | Parser
  Parser a ->
  -- | Printer
  (a -> Text) ->
  -- | 'Input' type
  Input a ->
  -- | initial value
  a ->
  SharedRep m a
repInput :: forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput Parser a
p a -> Text
pr Input a
i = forall (m :: * -> *) a r.
Monad m =>
(Text -> Either Text a)
-> (a -> Text) -> (Text -> a -> r) -> a -> SharedRepF m r a
register (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either String a
A.parseOnly Parser a
p) a -> Text
pr (\Text
n a
v -> forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml 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
.~ Text
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, ToHtml a) => Parser a -> (a -> Text) -> Input a -> a -> a -> SharedRep m a
repMessage :: forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> a -> SharedRep m a
repMessage Parser a
p a -> Text
_ Input a
i a
def a
a =
  forall (m :: * -> *) a r.
Monad m =>
(Text -> Either Text a)
-> (Text -> a -> r) -> a -> a -> SharedRepF m r a
message (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either String a
A.parseOnly Parser a
p) (\Text
n a
v -> forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml 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
.~ Text
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 Text ->
  Double ->
  Double ->
  Double ->
  Double ->
  SharedRep m Double
slider :: forall (m :: * -> *).
Monad m =>
Maybe Text
-> Double -> Double -> Double -> Double -> SharedRep m Double
slider Maybe Text
label Double
l Double
u Double
s Double
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Double
double
    (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Double
v Maybe Text
label forall a. Monoid a => a
mempty ([Attribute] -> InputType
Slider [Text -> Attribute
min_ (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
l), Text -> Attribute
max_ (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
u), Text -> Attribute
step_ (String -> Text
pack 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 Text ->
  Double ->
  Double ->
  Double ->
  Double ->
  SharedRep m Double
sliderV :: forall (m :: * -> *).
Monad m =>
Maybe Text
-> Double -> Double -> Double -> Double -> SharedRep m Double
sliderV Maybe Text
label Double
l Double
u Double
s Double
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Double
double
    (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Double
v Maybe Text
label forall a. Monoid a => a
mempty ([Attribute] -> InputType
SliderV [Text -> Attribute
min_ (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
l), Text -> Attribute
max_ (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
u), Text -> Attribute
step_ (String -> Text
pack 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, ToHtml a, P.Integral a, Show a) =>
  Maybe Text ->
  a ->
  a ->
  a ->
  a ->
  SharedRep m a
sliderI :: forall (m :: * -> *) a.
(Monad m, ToHtml a, Integral a, Show a) =>
Maybe Text -> a -> a -> a -> a -> SharedRep m a
sliderI Maybe Text
label a
l a
u a
s a
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    forall a. Integral a => Parser a
decimal
    (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input a
v Maybe Text
label forall a. Monoid a => a
mempty ([Attribute] -> InputType
Slider [Text -> Attribute
min_ (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
l), Text -> Attribute
max_ (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
u), Text -> Attribute
step_ (String -> Text
pack 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, ToHtml a, P.Integral a, Show a) =>
  Maybe Text ->
  a ->
  a ->
  a ->
  a ->
  SharedRep m a
sliderVI :: forall (m :: * -> *) a.
(Monad m, ToHtml a, Integral a, Show a) =>
Maybe Text -> a -> a -> a -> a -> SharedRep m a
sliderVI Maybe Text
label a
l a
u a
s a
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    forall a. Integral a => Parser a
decimal
    (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input a
v Maybe Text
label forall a. Monoid a => a
mempty ([Attribute] -> InputType
SliderV [Text -> Attribute
min_ (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
l), Text -> Attribute
max_ (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
u), Text -> Attribute
step_ (String -> Text
pack 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 Text
textbox :: (Monad m) => Maybe Text -> Text -> SharedRep m Text
textbox :: forall (m :: * -> *).
Monad m =>
Maybe Text -> Text -> SharedRep m Text
textbox Maybe Text
label Text
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Text
takeText
    forall a. a -> a
id
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Text
v Maybe Text
label forall a. Monoid a => a
mempty InputType
TextBox)
    Text
v

-- | textbox that only updates on focusout
textbox' :: (Monad m) => Maybe Text -> Text -> SharedRep m Text
textbox' :: forall (m :: * -> *).
Monad m =>
Maybe Text -> Text -> SharedRep m Text
textbox' Maybe Text
label Text
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Text
takeText
    forall a. a -> a
id
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Text
v Maybe Text
label forall a. Monoid a => a
mempty InputType
TextBox')
    Text
v

-- | textarea input element, specifying number of rows.
textarea :: (Monad m) => Int -> Maybe Text -> Text -> SharedRep m Text
textarea :: forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
rows Maybe Text
label Text
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Text
takeText
    forall a. a -> a
id
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Text
v Maybe Text
label forall a. Monoid a => a
mempty (Int -> InputType
TextArea Int
rows))
    Text
v

-- | Non-typed hex color input
colorPicker :: (Monad m) => Maybe Text -> Text -> SharedRep m Text
colorPicker :: forall (m :: * -> *).
Monad m =>
Maybe Text -> Text -> SharedRep m Text
colorPicker Maybe Text
label Text
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Text
takeText
    forall a. a -> a
id
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Text
v Maybe Text
label forall a. Monoid a => a
mempty InputType
ColorPicker)
    Text
v

-- | dropdown box
dropdown ::
  (Monad m, ToHtml a) =>
  -- | parse an a from Text
  Parser a ->
  -- | print an a to Text
  (a -> Text) ->
  -- | label suggestion
  Maybe Text ->
  -- | list of dropbox elements (as text)
  [Text] ->
  -- | initial value
  a ->
  SharedRep m a
dropdown :: forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a
-> (a -> Text) -> Maybe Text -> [Text] -> a -> SharedRep m a
dropdown Parser a
p a -> Text
pr Maybe Text
label [Text]
opts a
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser a
p
    a -> Text
pr
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input a
v Maybe Text
label forall a. Monoid a => a
mempty ([Text] -> InputType
Dropdown [Text]
opts))
    a
v

-- | dropdown box with multiple selections
dropdownMultiple ::
  (Monad m, ToHtml a) =>
  -- | parse an a from Text
  Parser a ->
  -- | print an a to Text
  (a -> Text) ->
  -- | label suggestion
  Maybe Text ->
  -- | list of dropbox elements (as text)
  [Text] ->
  -- | initial value
  [a] ->
  SharedRep m [a]
dropdownMultiple :: forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a
-> (a -> Text) -> Maybe Text -> [Text] -> [a] -> SharedRep m [a]
dropdownMultiple Parser a
p a -> Text
pr Maybe Text
label [Text]
opts [a]
vs =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    (Parser a
p forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser Char
char Char
',')
    (Text -> [Text] -> Text
intercalate Text
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Text
pr)
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input [a]
vs Maybe Text
label forall a. Monoid a => a
mempty ([Text] -> Char -> InputType
DropdownMultiple [Text]
opts Char
','))
    [a]
vs

-- | a datalist input
datalist :: (Monad m) => Maybe Text -> [Text] -> Text -> Text -> SharedRep m Text
datalist :: forall (m :: * -> *).
Monad m =>
Maybe Text -> [Text] -> Text -> Text -> SharedRep m Text
datalist Maybe Text
label [Text]
opts Text
v Text
id'' =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Text
takeText
    (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Text
v Maybe Text
label forall a. Monoid a => a
mempty ([Text] -> Text -> InputType
Datalist [Text]
opts Text
id''))
    Text
v

-- | A dropdown box designed to help represent a haskell sum type.
dropdownSum ::
  (Monad m, ToHtml a) =>
  Parser a ->
  (a -> Text) ->
  Maybe Text ->
  [Text] ->
  a ->
  SharedRep m a
dropdownSum :: forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a
-> (a -> Text) -> Maybe Text -> [Text] -> a -> SharedRep m a
dropdownSum Parser a
p a -> Text
pr Maybe Text
label [Text]
opts a
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser a
p
    a -> Text
pr
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input a
v Maybe Text
label forall a. Monoid a => a
mempty ([Text] -> InputType
DropdownSum [Text]
opts))
    a
v

-- | A checkbox input.
checkbox :: (Monad m) => Maybe Text -> Bool -> SharedRep m Bool
checkbox :: forall (m :: * -> *).
Monad m =>
Maybe Text -> Bool -> SharedRep m Bool
checkbox Maybe Text
label Bool
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    ((forall a. Eq a => a -> a -> Bool
== Text
"true") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeText)
    (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true")
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Bool
v Maybe Text
label forall a. Monoid a => a
mempty (Bool -> InputType
Checkbox Bool
v))
    Bool
v

-- | a toggle button
toggle :: (Monad m) => Maybe Text -> Bool -> SharedRep m Bool
toggle :: forall (m :: * -> *).
Monad m =>
Maybe Text -> Bool -> SharedRep m Bool
toggle Maybe Text
label Bool
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    ((forall a. Eq a => a -> a -> Bool
== Text
"true") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeText)
    (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true")
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Bool
v Maybe Text
label forall a. Monoid a => a
mempty (Bool -> Maybe Text -> InputType
Toggle Bool
v Maybe Text
label))
    Bool
v

-- | a toggle button, with no label
toggle_ :: (Monad m) => Maybe Text -> Bool -> SharedRep m Bool
toggle_ :: forall (m :: * -> *).
Monad m =>
Maybe Text -> Bool -> SharedRep m Bool
toggle_ Maybe Text
label Bool
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    ((forall a. Eq a => a -> a -> Bool
== Text
"true") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeText)
    (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true")
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Bool
v forall a. Maybe a
Nothing forall a. Monoid a => a
mempty (Bool -> Maybe Text -> InputType
Toggle Bool
v Maybe Text
label))
    Bool
v

-- | a button
button :: (Monad m) => Maybe Text -> SharedRep m Bool
button :: forall (m :: * -> *). Monad m => Maybe Text -> SharedRep m Bool
button Maybe Text
label =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> a -> SharedRep m a
repMessage
    (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
    (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true")
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Bool
False Maybe Text
label forall a. Monoid a => a
mempty InputType
Button)
    Bool
False
    Bool
False

-- | filename input
chooseFile :: (Monad m) => Maybe Text -> Text -> SharedRep m Text
chooseFile :: forall (m :: * -> *).
Monad m =>
Maybe Text -> Text -> SharedRep m Text
chooseFile Maybe Text
label Text
v =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Text
takeText
    (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
    (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Text
v Maybe Text
label forall a. Monoid a => a
mempty InputType
ChooseFile)
    Text
v

-- | Represent a Maybe using a checkbox.
--
-- Hides the underlying content on Nothing
maybeRep ::
  (Monad m) =>
  Maybe Text ->
  Bool ->
  SharedRep m a ->
  SharedRep m (Maybe a)
maybeRep :: forall (m :: * -> *) a.
Monad m =>
Maybe Text -> Bool -> SharedRep m a -> SharedRep m (Maybe a)
maybeRep Maybe Text
label Bool
st SharedRep m a
sa = forall (m :: * -> *) r a.
StateT (Int, HashMap Text Text) m (RepF r a) -> SharedRepF m r a
SharedRep forall a b. (a -> b) -> a -> b
$ do
  Text
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 => Text -> m Text
genNamePre Text
"maybe")
  forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) 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 (Text -> Html () -> Html () -> Html ()
hmap Text
id') forall {a}. Bool -> a -> Maybe a
mmap (forall (m :: * -> *).
Monad m =>
Maybe Text -> Text -> Bool -> SharedRep m Bool
checkboxShow Maybe Text
label Text
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 :: Text -> Html () -> Html () -> Html ()
hmap Text
id' Html ()
a Html ()
b =
      (Html (), [Attribute])
-> Maybe Text -> (Html (), [Attribute]) -> Html ()
cardify
        (Html ()
a, [])
        forall a. Maybe a
Nothing
        ( forall a. With a => a -> [Attribute] -> a
Lucid.with
            forall arg result. Term arg result => arg -> result
div_
            [ Text -> Attribute
id_ Text
id',
              forall arg result. TermRaw arg result => arg -> result
style_
                (Text
"display:" forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool Text
"none" Text
"block" Bool
st)
            ]
            Html ()
b,
          [forall arg result. TermRaw arg result => arg -> result
style_ Text
"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 Text -> Text -> Bool -> SharedRep m Bool
checkboxShow :: forall (m :: * -> *).
Monad m =>
Maybe Text -> Text -> Bool -> SharedRep m Bool
checkboxShow Maybe Text
label Text
id' Bool
v =
  forall (m :: * -> *) r a.
StateT (Int, HashMap Text Text) m (RepF r a) -> SharedRepF m r a
SharedRep forall a b. (a -> b) -> a -> b
$ do
    Text
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 Text
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 Text
name (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
v)))
    pure $
      forall r a.
r
-> (HashMap Text Text -> (HashMap Text Text, Either Text a))
-> RepF r a
Rep
        (forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml (forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Bool
v Maybe Text
label Text
name (Bool -> InputType
Checkbox Bool
v)) forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *). Monad m => Text -> Text -> HtmlT m ()
scriptToggleShow Text
name Text
id')
        ( \HashMap Text Text
s ->
            ( HashMap Text Text
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 Text
"HashMap.lookup failed")
                  (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either String a
parseOnly ((forall a. Eq a => a -> a -> Bool
== Text
"true") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeText))
                  (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
name HashMap Text Text
s)
            )
        )

-- | toggle show/hide
scriptToggleShow :: (Monad m) => Text -> Text -> HtmlT m ()
scriptToggleShow :: forall (m :: * -> *). Monad m => Text -> Text -> HtmlT m ()
scriptToggleShow Text
checkName Text
toggleId =
  forall arg result. TermRaw arg result => arg -> result
script_
    [qq|
$('#{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 Text -> Text -> Maybe Text -> (Text -> a -> SharedRep m a) -> [Text] -> [a] -> SharedRep m [a]
accordionList :: forall (m :: * -> *) a.
Monad m =>
Maybe Text
-> Text
-> Maybe Text
-> (Text -> a -> SharedRep m a)
-> [Text]
-> [a]
-> SharedRep m [a]
accordionList Maybe Text
title Text
prefix Maybe Text
open Text -> a -> SharedRep m a
srf [Text]
labels [a]
as = forall (m :: * -> *) r a.
StateT (Int, HashMap Text Text) m (RepF r a) -> SharedRepF m r a
SharedRep forall a b. (a -> b) -> a -> b
$ do
  (Rep StateT Int m (Html ())
h HashMap Text Text -> (HashMap Text Text, Either Text [a])
fa) <-
    forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) 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 =>
Text -> Maybe Text -> [(Text, Html ())] -> m (Html ())
accordion Text
prefix Maybe Text
open forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
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 [Html ()] [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 [Html ()] [a]
x)
          (forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
          (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> a -> SharedRep m a
srf [Text]
labels [a]
as)
  Html ()
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 (Html ())
h
  pure (forall r a.
r
-> (HashMap Text Text -> (HashMap Text Text, Either Text a))
-> RepF r a
Rep (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall arg result. Term arg result => arg -> result
h5_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
title forall a. Semigroup a => a -> a -> a
<> Html ()
h') HashMap Text Text -> (HashMap Text Text, Either Text [a])
fa)

-- | A (fixed-sized) list of (Bool, a) tuples.
accordionBoolList :: (Monad m) => Maybe Text -> Text -> (a -> SharedRep m a) -> (Bool -> SharedRep m Bool) -> [Text] -> [(Bool, a)] -> SharedRep m [(Bool, a)]
accordionBoolList :: forall (m :: * -> *) a.
Monad m =>
Maybe Text
-> Text
-> (a -> SharedRep m a)
-> (Bool -> SharedRep m Bool)
-> [Text]
-> [(Bool, a)]
-> SharedRep m [(Bool, a)]
accordionBoolList Maybe Text
title Text
prefix a -> SharedRep m a
bodyf Bool -> SharedRep m Bool
checkf [Text]
labels [(Bool, a)]
xs = forall (m :: * -> *) r a.
StateT (Int, HashMap Text Text) m (RepF r a) -> SharedRepF m r a
SharedRep forall a b. (a -> b) -> a -> b
$ do
  (Rep StateT Int m (Html ())
h HashMap Text Text -> (HashMap Text Text, Either Text [(Bool, a)])
fa) <-
    forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) 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 =>
Text -> [(Text, Html (), Html ())] -> m (Html ())
accordionChecked Text
prefix
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
l (Html ()
ch, Html ()
a) -> (Text
l, Html ()
a, Html ()
ch)) [Text]
labels
        )
        ( forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            (\SharedRepF m (Html (), Html ()) (Bool, a)
a SharedRepF m [(Html (), Html ())] [(Bool, a)]
x -> forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (:) (:) SharedRepF m (Html (), Html ()) (Bool, a)
a forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> SharedRepF m [(Html (), Html ())] [(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)
        )
  Html ()
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 (Html ())
h
  pure (forall r a.
r
-> (HashMap Text Text -> (HashMap Text Text, Either Text a))
-> RepF r a
Rep (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall arg result. Term arg result => arg -> result
h5_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
title forall a. Semigroup a => a -> a -> a
<> Html ()
h') HashMap Text Text -> (HashMap Text Text, Either Text [(Bool, a)])
fa)

-- | A fixed-sized list of Maybe a\'s
listMaybeRep :: (Monad m) => Maybe Text -> Text -> (Text -> Maybe a -> SharedRep m (Maybe a)) -> Int -> [a] -> SharedRep m [Maybe a]
listMaybeRep :: forall (m :: * -> *) a.
Monad m =>
Maybe Text
-> Text
-> (Text -> Maybe a -> SharedRep m (Maybe a))
-> Int
-> [a]
-> SharedRep m [Maybe a]
listMaybeRep Maybe Text
t Text
p Text -> Maybe a -> SharedRep m (Maybe a)
srf Int
n [a]
as =
  forall (m :: * -> *) a.
Monad m =>
Maybe Text
-> Text
-> Maybe Text
-> (Text -> a -> SharedRep m a)
-> [Text]
-> [a]
-> SharedRep m [a]
accordionList Maybe Text
t Text
p forall a. Maybe a
Nothing Text -> Maybe a -> SharedRep m (Maybe a)
srf (Int -> [Text]
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 Text ->
  Text ->
  -- | 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 Text
-> Text
-> (Bool -> SharedRep m Bool)
-> (a -> SharedRep m a)
-> Int
-> a
-> [a]
-> SharedRep m [a]
listRep Maybe Text
t Text
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 Text
-> Text
-> (a -> SharedRep m a)
-> (Bool -> SharedRep m Bool)
-> [Text]
-> [(Bool, a)]
-> SharedRep m [(Bool, a)]
accordionBoolList
      Maybe Text
t
      Text
p
      a -> SharedRep m a
srf
      Bool -> SharedRep m Bool
brf
      (Int -> [Text]
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 -> [Text]
defaultListLabels :: Int -> [Text]
defaultListLabels Int
n = (\Int
x -> Text
"[" forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (forall a. Show a => a -> String
show Int
x) forall a. Semigroup a => a -> a -> a
<> Text
"]") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. Int
n] :: [Text]

-- | Parse from a textbox
--
-- Uses focusout so as not to spam the reader.
readTextbox :: (Monad m, Read a, Show a) => Maybe Text -> a -> SharedRep m (Either Text a)
readTextbox :: forall (m :: * -> *) a.
(Monad m, Read a, Show a) =>
Maybe Text -> a -> SharedRep m (Either Text a)
readTextbox Maybe Text
label a
v = forall {b}. Read b => String -> Either Text b
parsed forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
Maybe Text -> Text -> SharedRep m Text
textbox' Maybe Text
label (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
v)
  where
    parsed :: String -> Either Text 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 -> Text
pack String
str)

-- | Representation of web concerns (css, js & html).
fiddle :: (Monad m) => Concerns Text -> SharedRep m (Concerns Text, Bool)
fiddle :: forall (m :: * -> *).
Monad m =>
Concerns Text -> SharedRep m (Concerns Text, Bool)
fiddle (Concerns Text
c Text
j Text
h) =
  forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
    (\Html ()
c' Html ()
j' Html ()
h' Html ()
up -> forall a. With a => a -> [Attribute] -> a
Lucid.with forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"fiddle "] forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Html ()
up, Html ()
h', Html ()
j', Html ()
c'])
    (\Text
c' Text
j' Text
h' Bool
up -> (forall a. a -> a -> a -> Concerns a
Concerns Text
c' Text
j' Text
h', Bool
up))
    (forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
10 (forall a. a -> Maybe a
Just Text
"css") Text
c)
    forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
10 (forall a. a -> Maybe a
Just Text
"js") Text
j
    forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
10 (forall a. a -> Maybe a
Just Text
"html") Text
h
    forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> forall (m :: * -> *). Monad m => Maybe Text -> SharedRep m Bool
button (forall a. a -> Maybe a
Just Text
"update")

-- | turns a SharedRep into a fiddle
viaFiddle ::
  (Monad m) =>
  SharedRep m a ->
  SharedRep m (Bool, Concerns Text, a)
viaFiddle :: forall (m :: * -> *) a.
Monad m =>
SharedRep m a -> SharedRep m (Bool, Concerns Text, a)
viaFiddle SharedRep m a
sr = forall (m :: * -> *) r a.
StateT (Int, HashMap Text Text) m (RepF r a) -> SharedRepF m r a
SharedRep forall a b. (a -> b) -> a -> b
$ do
  sr' :: RepF (Html ()) a
sr'@(Rep Html ()
h HashMap Text Text -> (HashMap Text Text, Either Text a)
_) <- forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) m (RepF r a)
unshare SharedRep m a
sr
  RepF (Html ()) Text
hrep <- forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) m (RepF r a)
unshare forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
10 (forall a. a -> Maybe a
Just Text
"html") (forall a. Html a -> Text
toText Html ()
h)
  RepF (Html ()) Text
crep <- forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) m (RepF r a)
unshare forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
10 (forall a. a -> Maybe a
Just Text
"css") forall a. Monoid a => a
mempty
  RepF (Html ()) Text
jrep <- forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) m (RepF r a)
unshare forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
10 (forall a. a -> Maybe a
Just Text
"js") forall a. Monoid a => a
mempty
  RepF (Html ()) Bool
u <- forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) m (RepF r a)
unshare forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => Maybe Text -> SharedRep m Bool
button (forall a. a -> Maybe a
Just Text
"update")
  pure $
    forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
      (\Html ()
up Html ()
a Html ()
b Html ()
c Html ()
_ -> forall a. With a => a -> [Attribute] -> a
Lucid.with forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"fiddle "] forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Html ()
up, Html ()
a, Html ()
b, Html ()
c])
      (\Bool
up Text
a Text
b Text
c a
d -> (Bool
up, forall a. a -> a -> a -> Concerns a
Concerns Text
a Text
b Text
c, a
d))
      RepF (Html ()) Bool
u
      forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> RepF (Html ()) Text
crep
      forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> RepF (Html ()) Text
jrep
      forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> RepF (Html ()) Text
hrep
      forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> RepF (Html ()) a
sr'

repChoice :: (Monad m) => Int -> [(Text, SharedRep m a)] -> SharedRep m a
repChoice :: forall (m :: * -> *) a.
Monad m =>
Int -> [(Text, SharedRep m a)] -> SharedRep m a
repChoice Int
initt [(Text, SharedRep m a)]
xs =
  forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall {arg} {result}.
(Term arg result, Monoid arg, With arg) =>
arg -> [arg] -> result
hmap forall {b}. Text -> [b] -> b
mmap SharedRep m Text
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 [Html ()] [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 [Html ()] [a]
a) (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) [SharedRep m a]
cs
  where
    ts :: [Text]
ts = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, 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
<$> [(Text, SharedRep m a)]
xs
    dd :: SharedRep m Text
dd = forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a
-> (a -> Text) -> Maybe Text -> [Text] -> a -> SharedRep m a
dropdownSum Parser Text
takeText forall a. a -> a
id forall a. Maybe a
Nothing [Text]
ts Text
t0
    t0 :: Text
t0 = [Text]
ts forall a. [a] -> Int -> a
List.!! Int
initt
    hmap :: arg -> [arg] -> result
hmap arg
dd' [arg]
cs' =
      forall arg result. Term arg result => arg -> result
div_
        ( arg
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 (forall a. With a => a -> Text -> Text -> a
`subtype` Text
t0) [arg]
cs' [Text]
ts)
        )
    mmap :: Text -> [b] -> b
mmap Text
dd' [b]
cs' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. [a] -> a
List.head [b]
cs') ([b]
cs' forall a. [a] -> Int -> a
List.!!) (forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex Text
dd' [Text]
ts)

-- | select test keys from a Map
selectItems :: [Text] -> HashMap.HashMap Text a -> [(Text, a)]
selectItems :: forall a. [Text] -> HashMap Text a -> [(Text, a)]
selectItems [Text]
ks HashMap Text 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 (\Text
k a
_ -> Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
ks) HashMap Text a
m

-- | rep of multiple items list
repItemsSelect :: (Monad m) => [Text] -> [Text] -> SharedRep m [Text]
repItemsSelect :: forall (m :: * -> *).
Monad m =>
[Text] -> [Text] -> SharedRep m [Text]
repItemsSelect [Text]
initial [Text]
full =
  forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a
-> (a -> Text) -> Maybe Text -> [Text] -> [a] -> SharedRep m [a]
dropdownMultiple ((Char -> Bool) -> Parser Text
A.takeWhile (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 Text
"items") [Text]
full [Text]
initial

subtype :: (With a) => a -> Text -> Text -> a
subtype :: forall a. With a => a -> Text -> Text -> a
subtype a
h Text
origt Text
t =
  forall a. With a => a -> [Attribute] -> a
with
    a
h
    [ Text -> Attribute
class__ Text
"subtype ",
      Text -> Text -> Attribute
data_ Text
"sumtype" Text
t,
      forall arg result. TermRaw arg result => arg -> result
style_ (Text
"display:" forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool Text
"block" Text
"none" (Text
origt forall a. Eq a => a -> a -> Bool
/= Text
t))
    ]