{-# 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,
    dropdown,
    dropdownMultiple,
    datalist,
    dropdownSum,
    colorPicker,
    textbox,
    textarea,
    checkbox,
    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 :: Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput Parser a
p a -> Text
pr Input a
i = (Text -> Either Text a)
-> (a -> Text)
-> (Text -> a -> HtmlT Identity ())
-> a
-> SharedRep m a
forall (m :: * -> *) a r.
Monad m =>
(Text -> Either Text a)
-> (a -> Text) -> (Text -> a -> r) -> a -> SharedRepF m r a
register ((String -> Text) -> Either String a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
pack (Either String a -> Either Text a)
-> (Text -> Either String a) -> Text -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser a
p) a -> Text
pr (\Text
n a
v -> Input a -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml (Input a -> HtmlT Identity ()) -> Input a -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ IsLabel "inputVal" (Optic A_Lens NoIx (Input a) (Input a) a a)
Optic A_Lens NoIx (Input a) (Input a) a a
#inputVal Optic A_Lens NoIx (Input a) (Input a) a a
-> a -> Input a -> Input a
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ a
v (Input a -> Input a) -> Input a -> Input a
forall a b. (a -> b) -> a -> b
$ IsLabel "inputId" (Optic A_Lens NoIx (Input a) (Input a) Text Text)
Optic A_Lens NoIx (Input a) (Input a) Text Text
#inputId Optic A_Lens NoIx (Input a) (Input a) Text Text
-> Text -> Input a -> Input a
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
n (Input a -> Input a) -> Input a -> Input a
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 :: Parser a -> (a -> Text) -> Input a -> a -> a -> SharedRep m a
repMessage Parser a
p a -> Text
_ Input a
i a
def a
a =
  (Text -> Either Text a)
-> (Text -> a -> HtmlT Identity ()) -> a -> a -> SharedRep m a
forall (m :: * -> *) a r.
Monad m =>
(Text -> Either Text a)
-> (Text -> a -> r) -> a -> a -> SharedRepF m r a
message ((String -> Text) -> Either String a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
pack (Either String a -> Either Text a)
-> (Text -> Either String a) -> Text -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser a
p) (\Text
n a
v -> Input a -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml (Input a -> HtmlT Identity ()) -> Input a -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ IsLabel "inputVal" (Optic A_Lens NoIx (Input a) (Input a) a a)
Optic A_Lens NoIx (Input a) (Input a) a a
#inputVal Optic A_Lens NoIx (Input a) (Input a) a a
-> a -> Input a -> Input a
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ a
v (Input a -> Input a) -> Input a -> Input a
forall a b. (a -> b) -> a -> b
$ IsLabel "inputId" (Optic A_Lens NoIx (Input a) (Input a) Text Text)
Optic A_Lens NoIx (Input a) (Input a) Text Text
#inputId Optic A_Lens NoIx (Input a) (Input a) Text Text
-> Text -> Input a -> Input a
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text
n (Input a -> Input a) -> Input a -> Input a
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 :: Maybe Text
-> Double -> Double -> Double -> Double -> SharedRep m Double
slider Maybe Text
label Double
l Double
u Double
s Double
v =
  Parser Double
-> (Double -> Text) -> Input Double -> Double -> SharedRep m Double
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Double
double
    (String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show)
    (Double -> Maybe Text -> Text -> InputType -> Input Double
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Double
v Maybe Text
label Text
forall a. Monoid a => a
mempty ([Attribute] -> InputType
Slider [Text -> Attribute
min_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
l), Text -> Attribute
max_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
u), Text -> Attribute
step_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
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 :: Maybe Text -> a -> a -> a -> a -> SharedRep m a
sliderI Maybe Text
label a
l a
u a
s a
v =
  Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser a
forall a. Integral a => Parser a
decimal
    (String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)
    (a -> Maybe Text -> Text -> InputType -> Input a
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input a
v Maybe Text
label Text
forall a. Monoid a => a
mempty ([Attribute] -> InputType
Slider [Text -> Attribute
min_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
l), Text -> Attribute
max_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
u), Text -> Attribute
step_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
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 :: Maybe Text -> Text -> SharedRep m Text
textbox Maybe Text
label Text
v =
  Parser Text
-> (Text -> Text) -> Input Text -> Text -> SharedRep m Text
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Text
takeText
    Text -> Text
forall a. a -> a
id
    (Text -> Maybe Text -> Text -> InputType -> Input Text
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Text
v Maybe Text
label Text
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' :: Maybe Text -> Text -> SharedRep m Text
textbox' Maybe Text
label Text
v =
  Parser Text
-> (Text -> Text) -> Input Text -> Text -> SharedRep m Text
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Text
takeText
    Text -> Text
forall a. a -> a
id
    (Text -> Maybe Text -> Text -> InputType -> Input Text
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Text
v Maybe Text
label Text
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 :: Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
rows Maybe Text
label Text
v =
  Parser Text
-> (Text -> Text) -> Input Text -> Text -> SharedRep m Text
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Text
takeText
    Text -> Text
forall a. a -> a
id
    (Text -> Maybe Text -> Text -> InputType -> Input Text
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Text
v Maybe Text
label Text
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 :: Maybe Text -> Text -> SharedRep m Text
colorPicker Maybe Text
label Text
v =
  Parser Text
-> (Text -> Text) -> Input Text -> Text -> SharedRep m Text
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Text
takeText
    Text -> Text
forall a. a -> a
id
    (Text -> Maybe Text -> Text -> InputType -> Input Text
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Text
v Maybe Text
label Text
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 :: 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 =
  Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser a
p
    a -> Text
pr
    (a -> Maybe Text -> Text -> InputType -> Input a
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input a
v Maybe Text
label Text
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 :: 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 =
  Parser [a] -> ([a] -> Text) -> Input [a] -> [a] -> SharedRep m [a]
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    (Parser a
p Parser a -> Parser Text Char -> Parser [a]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser Text Char
char Char
',')
    (Text -> [Text] -> Text
intercalate Text
"," ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Text
pr)
    ([a] -> Maybe Text -> Text -> InputType -> Input [a]
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input [a]
vs Maybe Text
label Text
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 :: Maybe Text -> [Text] -> Text -> Text -> SharedRep m Text
datalist Maybe Text
label [Text]
opts Text
v Text
id'' =
  Parser Text
-> (Text -> Text) -> Input Text -> Text -> SharedRep m Text
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Text
takeText
    (String -> Text
pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show)
    (Text -> Maybe Text -> Text -> InputType -> Input Text
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Text
v Maybe Text
label Text
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 :: 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 =
  Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser a
p
    a -> Text
pr
    (a -> Maybe Text -> Text -> InputType -> Input a
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input a
v Maybe Text
label Text
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 :: Maybe Text -> Bool -> SharedRep m Bool
checkbox Maybe Text
label Bool
v =
  Parser Bool
-> (Bool -> Text) -> Input Bool -> Bool -> SharedRep m Bool
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"true") (Text -> Bool) -> Parser Text -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeText)
    (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true")
    (Bool -> Maybe Text -> Text -> InputType -> Input Bool
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Bool
v Maybe Text
label Text
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 :: Maybe Text -> Bool -> SharedRep m Bool
toggle Maybe Text
label Bool
v =
  Parser Bool
-> (Bool -> Text) -> Input Bool -> Bool -> SharedRep m Bool
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"true") (Text -> Bool) -> Parser Text -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeText)
    (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true")
    (Bool -> Maybe Text -> Text -> InputType -> Input Bool
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Bool
v Maybe Text
label Text
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 :: Maybe Text -> SharedRep m Bool
button Maybe Text
label =
  Parser Bool
-> (Bool -> Text) -> Input Bool -> Bool -> Bool -> SharedRep m Bool
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> a -> SharedRep m a
repMessage
    (Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
    (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true")
    (Bool -> Maybe Text -> Text -> InputType -> Input Bool
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Bool
False Maybe Text
label Text
forall a. Monoid a => a
mempty InputType
Button)
    Bool
False
    Bool
False

-- | filename input
chooseFile :: (Monad m) => Maybe Text -> Text -> SharedRep m Text
chooseFile :: Maybe Text -> Text -> SharedRep m Text
chooseFile Maybe Text
label Text
v =
  Parser Text
-> (Text -> Text) -> Input Text -> Text -> SharedRep m Text
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a -> (a -> Text) -> Input a -> a -> SharedRep m a
repInput
    Parser Text
takeText
    (String -> Text
pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show)
    (Text -> Maybe Text -> Text -> InputType -> Input Text
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Text
v Maybe Text
label Text
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 :: Maybe Text -> Bool -> SharedRep m a -> SharedRep m (Maybe a)
maybeRep Maybe Text
label Bool
st SharedRep m a
sa = StateT
  (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) (Maybe a))
-> SharedRep m (Maybe a)
forall (m :: * -> *) r a.
StateT (Int, HashMap Text Text) m (RepF r a) -> SharedRepF m r a
SharedRep (StateT
   (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) (Maybe a))
 -> SharedRep m (Maybe a))
-> StateT
     (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) (Maybe a))
-> SharedRep m (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
  Text
id' <- Optic' A_Lens NoIx (Int, HashMap Text Text) Int
-> StateT Int m Text -> StateT (Int, HashMap Text Text) m Text
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 Optic' A_Lens NoIx (Int, HashMap Text Text) Int
forall s t a b. Field1 s t a b => Lens s t a b
_1 (Text -> StateT Int m Text
forall (m :: * -> *). MonadState Int m => Text -> m Text
genNamePre Text
"maybe")
  SharedRep m (Maybe a)
-> StateT
     (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) (Maybe a))
forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) m (RepF r a)
unshare (SharedRep m (Maybe a)
 -> StateT
      (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) (Maybe a)))
-> SharedRep m (Maybe a)
-> StateT
     (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) (Maybe a))
forall a b. (a -> b) -> a -> b
$ (HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ())
-> (Bool -> a -> Maybe a)
-> SharedRepF m (HtmlT Identity ()) Bool
-> SharedRepF
     m (HtmlT Identity () -> HtmlT Identity ()) (a -> Maybe a)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Text -> HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
hmap Text
id') Bool -> a -> Maybe a
forall a. Bool -> a -> Maybe a
mmap (Maybe Text -> Text -> Bool -> SharedRepF m (HtmlT Identity ()) Bool
forall (m :: * -> *).
Monad m =>
Maybe Text -> Text -> Bool -> SharedRep m Bool
checkboxShow Maybe Text
label Text
id' Bool
st) SharedRepF
  m (HtmlT Identity () -> HtmlT Identity ()) (a -> Maybe a)
-> SharedRep m a -> SharedRep m (Maybe a)
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 -> HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
hmap Text
id' HtmlT Identity ()
a HtmlT Identity ()
b =
      (HtmlT Identity (), [Attribute])
-> Maybe Text
-> (HtmlT Identity (), [Attribute])
-> HtmlT Identity ()
cardify
        (HtmlT Identity ()
a, [])
        Maybe Text
forall a. Maybe a
Nothing
        ( (HtmlT Identity () -> HtmlT Identity ())
-> [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall a. With a => a -> [Attribute] -> a
Lucid.with
            HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_
            [ Text -> Attribute
id_ Text
id',
              Text -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_
                (Text
"display:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"none" Text
"block" Bool
st)
            ]
            HtmlT Identity ()
b,
          [Text -> Attribute
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 = Maybe a -> Maybe a -> Bool -> Maybe a
forall a. a -> a -> Bool -> a
bool Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just a
b) Bool
a

checkboxShow :: (Monad m) => Maybe Text -> Text -> Bool -> SharedRep m Bool
checkboxShow :: Maybe Text -> Text -> Bool -> SharedRep m Bool
checkboxShow Maybe Text
label Text
id' Bool
v =
  StateT (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Bool)
-> SharedRep m Bool
forall (m :: * -> *) r a.
StateT (Int, HashMap Text Text) m (RepF r a) -> SharedRepF m r a
SharedRep (StateT (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Bool)
 -> SharedRep m Bool)
-> StateT
     (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Bool)
-> SharedRep m Bool
forall a b. (a -> b) -> a -> b
$ do
    Text
name <- Optic' A_Lens NoIx (Int, HashMap Text Text) Int
-> StateT Int m Text -> StateT (Int, HashMap Text Text) m Text
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 Optic' A_Lens NoIx (Int, HashMap Text Text) Int
forall s t a b. Field1 s t a b => Lens s t a b
_1 StateT Int m Text
forall (m :: * -> *). MonadState Int m => m Text
genName
    Optic' A_Lens NoIx (Int, HashMap Text Text) (HashMap Text Text)
-> StateT (HashMap Text Text) m ()
-> StateT (Int, HashMap Text Text) m ()
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 Optic' A_Lens NoIx (Int, HashMap Text Text) (HashMap Text Text)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((HashMap Text Text -> HashMap Text Text)
-> StateT (HashMap Text Text) m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
name (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
v)))
    pure $
      HtmlT Identity ()
-> (HashMap Text Text -> (HashMap Text Text, Either Text Bool))
-> RepF (HtmlT Identity ()) Bool
forall r a.
r
-> (HashMap Text Text -> (HashMap Text Text, Either Text a))
-> RepF r a
Rep
        (Input Bool -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml (Bool -> Maybe Text -> Text -> InputType -> Input Bool
forall a. a -> Maybe Text -> Text -> InputType -> Input a
Input Bool
v Maybe Text
label Text
name (Bool -> InputType
Checkbox Bool
v)) HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> HtmlT Identity ()
forall (m :: * -> *). Monad m => Text -> Text -> HtmlT m ()
scriptToggleShow Text
name Text
id')
        ( \HashMap Text Text
s ->
            ( HashMap Text Text
s,
              Either Text (Either Text Bool) -> Either Text Bool
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either Text (Either Text Bool) -> Either Text Bool)
-> Either Text (Either Text Bool) -> Either Text Bool
forall a b. (a -> b) -> a -> b
$
                Either Text (Either Text Bool)
-> (Either Text Bool -> Either Text (Either Text Bool))
-> Maybe (Either Text Bool)
-> Either Text (Either Text Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text (Either Text Bool)
forall a b. a -> Either a b
Left Text
"HashMap.lookup failed") Either Text Bool -> Either Text (Either Text Bool)
forall a b. b -> Either a b
Right (Maybe (Either Text Bool) -> Either Text (Either Text Bool))
-> Maybe (Either Text Bool) -> Either Text (Either Text Bool)
forall a b. (a -> b) -> a -> b
$
                  (String -> Either Text Bool)
-> (Bool -> Either Text Bool)
-> Either String Bool
-> Either Text Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Either Text Bool
forall a b. a -> Either a b
Left (Text -> Either Text Bool)
-> (String -> Text) -> String -> Either Text Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) Bool -> Either Text Bool
forall a b. b -> Either a b
Right (Either String Bool -> Either Text Bool)
-> (Text -> Either String Bool) -> Text -> Either Text Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Bool -> Text -> Either String Bool
forall a. Parser a -> Text -> Either String a
parseOnly ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"true") (Text -> Bool) -> Parser Text -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeText)
                    (Text -> Either Text Bool)
-> Maybe Text -> Maybe (Either Text Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Text -> Maybe Text
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 :: Text -> Text -> HtmlT m ()
scriptToggleShow Text
checkName Text
toggleId =
  Text -> HtmlT m ()
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 :: 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 = StateT (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) [a])
-> SharedRep m [a]
forall (m :: * -> *) r a.
StateT (Int, HashMap Text Text) m (RepF r a) -> SharedRepF m r a
SharedRep (StateT (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) [a])
 -> SharedRep m [a])
-> StateT (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) [a])
-> SharedRep m [a]
forall a b. (a -> b) -> a -> b
$ do
  (Rep StateT Int m (HtmlT Identity ())
h HashMap Text Text -> (HashMap Text Text, Either Text [a])
fa) <-
    SharedRepF m (StateT Int m (HtmlT Identity ())) [a]
-> StateT
     (Int, HashMap Text Text)
     m
     (RepF (StateT Int m (HtmlT Identity ())) [a])
forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) m (RepF r a)
unshare (SharedRepF m (StateT Int m (HtmlT Identity ())) [a]
 -> StateT
      (Int, HashMap Text Text)
      m
      (RepF (StateT Int m (HtmlT Identity ())) [a]))
-> SharedRepF m (StateT Int m (HtmlT Identity ())) [a]
-> StateT
     (Int, HashMap Text Text)
     m
     (RepF (StateT Int m (HtmlT Identity ())) [a])
forall a b. (a -> b) -> a -> b
$
      ([HtmlT Identity ()] -> StateT Int m (HtmlT Identity ()))
-> SharedRepF m [HtmlT Identity ()] [a]
-> SharedRepF m (StateT Int m (HtmlT Identity ())) [a]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
-> Maybe Text
-> [(Text, HtmlT Identity ())]
-> StateT Int m (HtmlT Identity ())
forall (m :: * -> *).
MonadState Int m =>
Text
-> Maybe Text
-> [(Text, HtmlT Identity ())]
-> m (HtmlT Identity ())
accordion Text
prefix Maybe Text
open ([(Text, HtmlT Identity ())] -> StateT Int m (HtmlT Identity ()))
-> ([HtmlT Identity ()] -> [(Text, HtmlT Identity ())])
-> [HtmlT Identity ()]
-> StateT Int m (HtmlT Identity ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [HtmlT Identity ()] -> [(Text, HtmlT Identity ())]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
labels) (SharedRepF m [HtmlT Identity ()] [a]
 -> SharedRepF m (StateT Int m (HtmlT Identity ())) [a])
-> SharedRepF m [HtmlT Identity ()] [a]
-> SharedRepF m (StateT Int m (HtmlT Identity ())) [a]
forall a b. (a -> b) -> a -> b
$
        (SharedRep m a
 -> SharedRepF m [HtmlT Identity ()] [a]
 -> SharedRepF m [HtmlT Identity ()] [a])
-> SharedRepF m [HtmlT Identity ()] [a]
-> [SharedRep m a]
-> SharedRepF m [HtmlT Identity ()] [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
          (\SharedRep m a
a SharedRepF m [HtmlT Identity ()] [a]
x -> (HtmlT Identity () -> [HtmlT Identity ()] -> [HtmlT Identity ()])
-> (a -> [a] -> [a])
-> SharedRep m a
-> SharedRepF
     m ([HtmlT Identity ()] -> [HtmlT Identity ()]) ([a] -> [a])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (:) (:) SharedRep m a
a SharedRepF
  m ([HtmlT Identity ()] -> [HtmlT Identity ()]) ([a] -> [a])
-> SharedRepF m [HtmlT Identity ()] [a]
-> SharedRepF m [HtmlT Identity ()] [a]
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> SharedRepF m [HtmlT Identity ()] [a]
x)
          ([a] -> SharedRepF m [HtmlT Identity ()] [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
          ((Text -> a -> SharedRep m a) -> [Text] -> [a] -> [SharedRep m a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> a -> SharedRep m a
srf [Text]
labels [a]
as)
  HtmlT Identity ()
h' <- Optic' A_Lens NoIx (Int, HashMap Text Text) Int
-> StateT Int m (HtmlT Identity ())
-> StateT (Int, HashMap Text Text) m (HtmlT Identity ())
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 Optic' A_Lens NoIx (Int, HashMap Text Text) Int
forall s t a b. Field1 s t a b => Lens s t a b
_1 StateT Int m (HtmlT Identity ())
h
  pure (HtmlT Identity ()
-> (HashMap Text Text -> (HashMap Text Text, Either Text [a]))
-> RepF (HtmlT Identity ()) [a]
forall r a.
r
-> (HashMap Text Text -> (HashMap Text Text, Either Text a))
-> RepF r a
Rep (HtmlT Identity ()
-> (Text -> HtmlT Identity ()) -> Maybe Text -> HtmlT Identity ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT Identity ()
forall a. Monoid a => a
mempty (HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
h5_ (HtmlT Identity () -> HtmlT Identity ())
-> (Text -> HtmlT Identity ()) -> Text -> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
title HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
forall a. Semigroup a => a -> a -> a
<> HtmlT Identity ()
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 :: 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 = StateT
  (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) [(Bool, a)])
-> SharedRep m [(Bool, a)]
forall (m :: * -> *) r a.
StateT (Int, HashMap Text Text) m (RepF r a) -> SharedRepF m r a
SharedRep (StateT
   (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) [(Bool, a)])
 -> SharedRep m [(Bool, a)])
-> StateT
     (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) [(Bool, a)])
-> SharedRep m [(Bool, a)]
forall a b. (a -> b) -> a -> b
$ do
  (Rep StateT Int m (HtmlT Identity ())
h HashMap Text Text -> (HashMap Text Text, Either Text [(Bool, a)])
fa) <-
    SharedRepF m (StateT Int m (HtmlT Identity ())) [(Bool, a)]
-> StateT
     (Int, HashMap Text Text)
     m
     (RepF (StateT Int m (HtmlT Identity ())) [(Bool, a)])
forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) m (RepF r a)
unshare (SharedRepF m (StateT Int m (HtmlT Identity ())) [(Bool, a)]
 -> StateT
      (Int, HashMap Text Text)
      m
      (RepF (StateT Int m (HtmlT Identity ())) [(Bool, a)]))
-> SharedRepF m (StateT Int m (HtmlT Identity ())) [(Bool, a)]
-> StateT
     (Int, HashMap Text Text)
     m
     (RepF (StateT Int m (HtmlT Identity ())) [(Bool, a)])
forall a b. (a -> b) -> a -> b
$
      ([(HtmlT Identity (), HtmlT Identity ())]
 -> StateT Int m (HtmlT Identity ()))
-> SharedRepF
     m [(HtmlT Identity (), HtmlT Identity ())] [(Bool, a)]
-> SharedRepF m (StateT Int m (HtmlT Identity ())) [(Bool, a)]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
        ( Text
-> [(Text, HtmlT Identity (), HtmlT Identity ())]
-> StateT Int m (HtmlT Identity ())
forall (m :: * -> *).
MonadState Int m =>
Text
-> [(Text, HtmlT Identity (), HtmlT Identity ())]
-> m (HtmlT Identity ())
accordionChecked Text
prefix
            ([(Text, HtmlT Identity (), HtmlT Identity ())]
 -> StateT Int m (HtmlT Identity ()))
-> ([(HtmlT Identity (), HtmlT Identity ())]
    -> [(Text, HtmlT Identity (), HtmlT Identity ())])
-> [(HtmlT Identity (), HtmlT Identity ())]
-> StateT Int m (HtmlT Identity ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
 -> (HtmlT Identity (), HtmlT Identity ())
 -> (Text, HtmlT Identity (), HtmlT Identity ()))
-> [Text]
-> [(HtmlT Identity (), HtmlT Identity ())]
-> [(Text, HtmlT Identity (), HtmlT Identity ())]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
l (HtmlT Identity ()
ch, HtmlT Identity ()
a) -> (Text
l, HtmlT Identity ()
a, HtmlT Identity ()
ch)) [Text]
labels
        )
        ( (SharedRepF m (HtmlT Identity (), HtmlT Identity ()) (Bool, a)
 -> SharedRepF
      m [(HtmlT Identity (), HtmlT Identity ())] [(Bool, a)]
 -> SharedRepF
      m [(HtmlT Identity (), HtmlT Identity ())] [(Bool, a)])
-> SharedRepF
     m [(HtmlT Identity (), HtmlT Identity ())] [(Bool, a)]
-> [SharedRepF m (HtmlT Identity (), HtmlT Identity ()) (Bool, a)]
-> SharedRepF
     m [(HtmlT Identity (), HtmlT Identity ())] [(Bool, a)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            (\SharedRepF m (HtmlT Identity (), HtmlT Identity ()) (Bool, a)
a SharedRepF m [(HtmlT Identity (), HtmlT Identity ())] [(Bool, a)]
x -> ((HtmlT Identity (), HtmlT Identity ())
 -> [(HtmlT Identity (), HtmlT Identity ())]
 -> [(HtmlT Identity (), HtmlT Identity ())])
-> ((Bool, a) -> [(Bool, a)] -> [(Bool, a)])
-> SharedRepF m (HtmlT Identity (), HtmlT Identity ()) (Bool, a)
-> SharedRepF
     m
     ([(HtmlT Identity (), HtmlT Identity ())]
      -> [(HtmlT Identity (), HtmlT Identity ())])
     ([(Bool, a)] -> [(Bool, a)])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (:) (:) SharedRepF m (HtmlT Identity (), HtmlT Identity ()) (Bool, a)
a SharedRepF
  m
  ([(HtmlT Identity (), HtmlT Identity ())]
   -> [(HtmlT Identity (), HtmlT Identity ())])
  ([(Bool, a)] -> [(Bool, a)])
-> SharedRepF
     m [(HtmlT Identity (), HtmlT Identity ())] [(Bool, a)]
-> SharedRepF
     m [(HtmlT Identity (), HtmlT Identity ())] [(Bool, a)]
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> SharedRepF m [(HtmlT Identity (), HtmlT Identity ())] [(Bool, a)]
x)
            ([(Bool, a)]
-> SharedRepF
     m [(HtmlT Identity (), HtmlT Identity ())] [(Bool, a)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
            ((\(Bool
ch, a
a) -> (HtmlT Identity ()
 -> HtmlT Identity () -> (HtmlT Identity (), HtmlT Identity ()))
-> (Bool -> a -> (Bool, a))
-> SharedRep m Bool
-> SharedRepF
     m
     (HtmlT Identity () -> (HtmlT Identity (), HtmlT Identity ()))
     (a -> (Bool, 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) SharedRepF
  m
  (HtmlT Identity () -> (HtmlT Identity (), HtmlT Identity ()))
  (a -> (Bool, a))
-> SharedRep m a
-> SharedRepF m (HtmlT Identity (), HtmlT Identity ()) (Bool, a)
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) ((Bool, a)
 -> SharedRepF m (HtmlT Identity (), HtmlT Identity ()) (Bool, a))
-> [(Bool, a)]
-> [SharedRepF m (HtmlT Identity (), HtmlT Identity ()) (Bool, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Bool, a)]
xs)
        )
  HtmlT Identity ()
h' <- Optic' A_Lens NoIx (Int, HashMap Text Text) Int
-> StateT Int m (HtmlT Identity ())
-> StateT (Int, HashMap Text Text) m (HtmlT Identity ())
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 Optic' A_Lens NoIx (Int, HashMap Text Text) Int
forall s t a b. Field1 s t a b => Lens s t a b
_1 StateT Int m (HtmlT Identity ())
h
  pure (HtmlT Identity ()
-> (HashMap Text Text
    -> (HashMap Text Text, Either Text [(Bool, a)]))
-> RepF (HtmlT Identity ()) [(Bool, a)]
forall r a.
r
-> (HashMap Text Text -> (HashMap Text Text, Either Text a))
-> RepF r a
Rep (HtmlT Identity ()
-> (Text -> HtmlT Identity ()) -> Maybe Text -> HtmlT Identity ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT Identity ()
forall a. Monoid a => a
mempty (HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
h5_ (HtmlT Identity () -> HtmlT Identity ())
-> (Text -> HtmlT Identity ()) -> Text -> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
title HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
forall a. Semigroup a => a -> a -> a
<> HtmlT Identity ()
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 :: 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 =
  Maybe Text
-> Text
-> Maybe Text
-> (Text -> Maybe a -> SharedRep m (Maybe a))
-> [Text]
-> [Maybe a]
-> SharedRep m [Maybe a]
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 Maybe Text
forall a. Maybe a
Nothing Text -> Maybe a -> SharedRep m (Maybe a)
srf (Int -> [Text]
defaultListLabels Int
n) (Int -> [Maybe a] -> [Maybe a]
forall a. Int -> [a] -> [a]
take Int
n ((a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> [a] -> [Maybe a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as) [Maybe a] -> [Maybe a] -> [Maybe a]
forall a. Semigroup a => a -> a -> a
<> Maybe a -> [Maybe a]
forall a. a -> [a]
repeat Maybe a
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 :: 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 =
  ([(Bool, a)] -> [a])
-> SharedRepF m (HtmlT Identity ()) [(Bool, a)] -> SharedRep m [a]
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> ([(Bool, a)] -> [[a]]) -> [(Bool, a)] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, a) -> [a]) -> [(Bool, a)] -> [[a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Bool
b, a
a) -> [a] -> [a] -> Bool -> [a]
forall a. a -> a -> Bool -> a
bool [] [a
a] Bool
b)) (SharedRepF m (HtmlT Identity ()) [(Bool, a)] -> SharedRep m [a])
-> SharedRepF m (HtmlT Identity ()) [(Bool, a)] -> SharedRep m [a]
forall a b. (a -> b) -> a -> b
$
    Maybe Text
-> Text
-> (a -> SharedRep m a)
-> (Bool -> SharedRep m Bool)
-> [Text]
-> [(Bool, a)]
-> SharedRepF m (HtmlT Identity ()) [(Bool, a)]
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)
      (Int -> [(Bool, a)] -> [(Bool, a)]
forall a. Int -> [a] -> [a]
take Int
n (((Bool
True,) (a -> (Bool, a)) -> [a] -> [(Bool, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as) [(Bool, a)] -> [(Bool, a)] -> [(Bool, a)]
forall a. Semigroup a => a -> a -> a
<> (Bool, a) -> [(Bool, 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
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") (Int -> Text) -> [Int] -> [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 :: Maybe Text -> a -> SharedRep m (Either Text a)
readTextbox Maybe Text
label a
v = String -> Either Text a
forall b. Read b => String -> Either Text b
parsed (String -> Either Text a)
-> (Text -> String) -> Text -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> Either Text a)
-> SharedRepF m (HtmlT Identity ()) Text
-> SharedRep m (Either Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Text -> SharedRepF m (HtmlT Identity ()) Text
forall (m :: * -> *).
Monad m =>
Maybe Text -> Text -> SharedRep m Text
textbox' Maybe Text
label (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
v)
  where
    parsed :: String -> Either Text b
parsed String
str =
      case ReadS b
forall a. Read a => ReadS a
reads String
str of
        [(b
a, String
"")] -> b -> Either Text b
forall a b. b -> Either a b
Right b
a
        [(b, String)]
_badRead -> Text -> Either Text b
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 :: Concerns Text -> SharedRep m (Concerns Text, Bool)
fiddle (Concerns Text
c Text
j Text
h) =
  (HtmlT Identity ()
 -> HtmlT Identity ()
 -> HtmlT Identity ()
 -> HtmlT Identity ()
 -> HtmlT Identity ())
-> (Text -> Text -> Text -> Bool -> (Concerns Text, Bool))
-> SharedRepF m (HtmlT Identity ()) Text
-> SharedRepF
     m
     (HtmlT Identity ()
      -> HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ())
     (Text -> Text -> Bool -> (Concerns Text, Bool))
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
    (\HtmlT Identity ()
c' HtmlT Identity ()
j' HtmlT Identity ()
h' HtmlT Identity ()
up -> (HtmlT Identity () -> HtmlT Identity ())
-> [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall a. With a => a -> [Attribute] -> a
Lucid.with HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"fiddle "] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ [HtmlT Identity ()] -> HtmlT Identity ()
forall a. Monoid a => [a] -> a
mconcat [HtmlT Identity ()
up, HtmlT Identity ()
h', HtmlT Identity ()
j', HtmlT Identity ()
c'])
    (\Text
c' Text
j' Text
h' Bool
up -> (Text -> Text -> Text -> Concerns Text
forall a. a -> a -> a -> Concerns a
Concerns Text
c' Text
j' Text
h', Bool
up))
    (Int -> Maybe Text -> Text -> SharedRepF m (HtmlT Identity ()) Text
forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
10 (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"css") Text
c)
    SharedRepF
  m
  (HtmlT Identity ()
   -> HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ())
  (Text -> Text -> Bool -> (Concerns Text, Bool))
-> SharedRepF m (HtmlT Identity ()) Text
-> SharedRepF
     m
     (HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ())
     (Text -> Bool -> (Concerns Text, Bool))
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> Int -> Maybe Text -> Text -> SharedRepF m (HtmlT Identity ()) Text
forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
10 (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"js") Text
j
    SharedRepF
  m
  (HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ())
  (Text -> Bool -> (Concerns Text, Bool))
-> SharedRepF m (HtmlT Identity ()) Text
-> SharedRepF
     m
     (HtmlT Identity () -> HtmlT Identity ())
     (Bool -> (Concerns Text, Bool))
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> Int -> Maybe Text -> Text -> SharedRepF m (HtmlT Identity ()) Text
forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
10 (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"html") Text
h
    SharedRepF
  m
  (HtmlT Identity () -> HtmlT Identity ())
  (Bool -> (Concerns Text, Bool))
-> SharedRepF m (HtmlT Identity ()) Bool
-> SharedRep m (Concerns Text, Bool)
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> Maybe Text -> SharedRepF m (HtmlT Identity ()) Bool
forall (m :: * -> *). Monad m => Maybe Text -> SharedRep m Bool
button (Text -> Maybe Text
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 :: SharedRep m a -> SharedRep m (Bool, Concerns Text, a)
viaFiddle SharedRep m a
sr = StateT
  (Int, HashMap Text Text)
  m
  (RepF (HtmlT Identity ()) (Bool, Concerns Text, a))
-> SharedRep m (Bool, Concerns Text, a)
forall (m :: * -> *) r a.
StateT (Int, HashMap Text Text) m (RepF r a) -> SharedRepF m r a
SharedRep (StateT
   (Int, HashMap Text Text)
   m
   (RepF (HtmlT Identity ()) (Bool, Concerns Text, a))
 -> SharedRep m (Bool, Concerns Text, a))
-> StateT
     (Int, HashMap Text Text)
     m
     (RepF (HtmlT Identity ()) (Bool, Concerns Text, a))
-> SharedRep m (Bool, Concerns Text, a)
forall a b. (a -> b) -> a -> b
$ do
  sr' :: RepF (HtmlT Identity ()) a
sr'@(Rep HtmlT Identity ()
h HashMap Text Text -> (HashMap Text Text, Either Text a)
_) <- SharedRep m a
-> StateT (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) a)
forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) m (RepF r a)
unshare SharedRep m a
sr
  RepF (HtmlT Identity ()) Text
hrep <- SharedRepF m (HtmlT Identity ()) Text
-> StateT
     (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Text)
forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) m (RepF r a)
unshare (SharedRepF m (HtmlT Identity ()) Text
 -> StateT
      (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Text))
-> SharedRepF m (HtmlT Identity ()) Text
-> StateT
     (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Text)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Text -> Text -> SharedRepF m (HtmlT Identity ()) Text
forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
10 (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"html") (HtmlT Identity () -> Text
forall a. Html a -> Text
toText HtmlT Identity ()
h)
  RepF (HtmlT Identity ()) Text
crep <- SharedRepF m (HtmlT Identity ()) Text
-> StateT
     (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Text)
forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) m (RepF r a)
unshare (SharedRepF m (HtmlT Identity ()) Text
 -> StateT
      (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Text))
-> SharedRepF m (HtmlT Identity ()) Text
-> StateT
     (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Text)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Text -> Text -> SharedRepF m (HtmlT Identity ()) Text
forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
10 (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"css") Text
forall a. Monoid a => a
mempty
  RepF (HtmlT Identity ()) Text
jrep <- SharedRepF m (HtmlT Identity ()) Text
-> StateT
     (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Text)
forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) m (RepF r a)
unshare (SharedRepF m (HtmlT Identity ()) Text
 -> StateT
      (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Text))
-> SharedRepF m (HtmlT Identity ()) Text
-> StateT
     (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Text)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Text -> Text -> SharedRepF m (HtmlT Identity ()) Text
forall (m :: * -> *).
Monad m =>
Int -> Maybe Text -> Text -> SharedRep m Text
textarea Int
10 (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"js") Text
forall a. Monoid a => a
mempty
  RepF (HtmlT Identity ()) Bool
u <- SharedRepF m (HtmlT Identity ()) Bool
-> StateT
     (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Bool)
forall (m :: * -> *) r a.
SharedRepF m r a -> StateT (Int, HashMap Text Text) m (RepF r a)
unshare (SharedRepF m (HtmlT Identity ()) Bool
 -> StateT
      (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Bool))
-> SharedRepF m (HtmlT Identity ()) Bool
-> StateT
     (Int, HashMap Text Text) m (RepF (HtmlT Identity ()) Bool)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> SharedRepF m (HtmlT Identity ()) Bool
forall (m :: * -> *). Monad m => Maybe Text -> SharedRep m Bool
button (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"update")
  pure $
    (HtmlT Identity ()
 -> HtmlT Identity ()
 -> HtmlT Identity ()
 -> HtmlT Identity ()
 -> HtmlT Identity ()
 -> HtmlT Identity ())
-> (Bool -> Text -> Text -> Text -> a -> (Bool, Concerns Text, a))
-> RepF (HtmlT Identity ()) Bool
-> RepF
     (HtmlT Identity ()
      -> HtmlT Identity ()
      -> HtmlT Identity ()
      -> HtmlT Identity ()
      -> HtmlT Identity ())
     (Text -> Text -> Text -> a -> (Bool, Concerns Text, a))
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
      (\HtmlT Identity ()
up HtmlT Identity ()
a HtmlT Identity ()
b HtmlT Identity ()
c HtmlT Identity ()
_ -> (HtmlT Identity () -> HtmlT Identity ())
-> [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall a. With a => a -> [Attribute] -> a
Lucid.with HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"fiddle "] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ [HtmlT Identity ()] -> HtmlT Identity ()
forall a. Monoid a => [a] -> a
mconcat [HtmlT Identity ()
up, HtmlT Identity ()
a, HtmlT Identity ()
b, HtmlT Identity ()
c])
      (\Bool
up Text
a Text
b Text
c a
d -> (Bool
up, Text -> Text -> Text -> Concerns Text
forall a. a -> a -> a -> Concerns a
Concerns Text
a Text
b Text
c, a
d))
      RepF (HtmlT Identity ()) Bool
u
      RepF
  (HtmlT Identity ()
   -> HtmlT Identity ()
   -> HtmlT Identity ()
   -> HtmlT Identity ()
   -> HtmlT Identity ())
  (Text -> Text -> Text -> a -> (Bool, Concerns Text, a))
-> RepF (HtmlT Identity ()) Text
-> RepF
     (HtmlT Identity ()
      -> HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ())
     (Text -> Text -> a -> (Bool, Concerns Text, a))
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> RepF (HtmlT Identity ()) Text
crep
      RepF
  (HtmlT Identity ()
   -> HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ())
  (Text -> Text -> a -> (Bool, Concerns Text, a))
-> RepF (HtmlT Identity ()) Text
-> RepF
     (HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ())
     (Text -> a -> (Bool, Concerns Text, a))
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> RepF (HtmlT Identity ()) Text
jrep
      RepF
  (HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ())
  (Text -> a -> (Bool, Concerns Text, a))
-> RepF (HtmlT Identity ()) Text
-> RepF
     (HtmlT Identity () -> HtmlT Identity ())
     (a -> (Bool, Concerns Text, a))
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> RepF (HtmlT Identity ()) Text
hrep
      RepF
  (HtmlT Identity () -> HtmlT Identity ())
  (a -> (Bool, Concerns Text, a))
-> RepF (HtmlT Identity ()) a
-> RepF (HtmlT Identity ()) (Bool, Concerns Text, a)
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> RepF (HtmlT Identity ()) a
sr'

repChoice :: (Monad m) => Int -> [(Text, SharedRep m a)] -> SharedRep m a
repChoice :: Int -> [(Text, SharedRep m a)] -> SharedRep m a
repChoice Int
initt [(Text, SharedRep m a)]
xs =
  (HtmlT Identity () -> [HtmlT Identity ()] -> HtmlT Identity ())
-> (Text -> [a] -> a)
-> SharedRepF m (HtmlT Identity ()) Text
-> SharedRepF
     m ([HtmlT Identity ()] -> HtmlT Identity ()) ([a] -> a)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap HtmlT Identity () -> [HtmlT Identity ()] -> HtmlT Identity ()
forall arg result.
(Term arg result, Monoid arg, With arg) =>
arg -> [arg] -> result
hmap Text -> [a] -> a
forall b. Text -> [b] -> b
mmap SharedRepF m (HtmlT Identity ()) Text
dd
    SharedRepF m ([HtmlT Identity ()] -> HtmlT Identity ()) ([a] -> a)
-> SharedRepF m [HtmlT Identity ()] [a] -> SharedRep m a
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> (SharedRep m a
 -> SharedRepF m [HtmlT Identity ()] [a]
 -> SharedRepF m [HtmlT Identity ()] [a])
-> SharedRepF m [HtmlT Identity ()] [a]
-> [SharedRep m a]
-> SharedRepF m [HtmlT Identity ()] [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\SharedRep m a
x SharedRepF m [HtmlT Identity ()] [a]
a -> (HtmlT Identity () -> [HtmlT Identity ()] -> [HtmlT Identity ()])
-> (a -> [a] -> [a])
-> SharedRep m a
-> SharedRepF
     m ([HtmlT Identity ()] -> [HtmlT Identity ()]) ([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 SharedRepF
  m ([HtmlT Identity ()] -> [HtmlT Identity ()]) ([a] -> [a])
-> SharedRepF m [HtmlT Identity ()] [a]
-> SharedRepF m [HtmlT Identity ()] [a]
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> SharedRepF m [HtmlT Identity ()] [a]
a) ([a] -> SharedRepF m [HtmlT Identity ()] [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) [SharedRep m a]
cs
  where
    ts :: [Text]
ts = (Text, SharedRep m a) -> Text
forall a b. (a, b) -> a
fst ((Text, SharedRep m a) -> Text)
-> [(Text, SharedRep m a)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, SharedRep m a)]
xs
    cs :: [SharedRep m a]
cs = (Text, SharedRep m a) -> SharedRep m a
forall a b. (a, b) -> b
snd ((Text, SharedRep m a) -> SharedRep m a)
-> [(Text, SharedRep m a)] -> [SharedRep m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, SharedRep m a)]
xs
    dd :: SharedRepF m (HtmlT Identity ()) Text
dd = Parser Text
-> (Text -> Text)
-> Maybe Text
-> [Text]
-> Text
-> SharedRepF m (HtmlT Identity ()) Text
forall (m :: * -> *) a.
(Monad m, ToHtml a) =>
Parser a
-> (a -> Text) -> Maybe Text -> [Text] -> a -> SharedRep m a
dropdownSum Parser Text
takeText Text -> Text
forall a. a -> a
id Maybe Text
forall a. Maybe a
Nothing [Text]
ts Text
t0
    t0 :: Text
t0 = [Text]
ts [Text] -> Int -> Text
forall a. [a] -> Int -> a
List.!! Int
initt
    hmap :: arg -> [arg] -> result
hmap arg
dd' [arg]
cs' =
      arg -> result
forall arg result. Term arg result => arg -> result
div_
        ( arg
dd'
            arg -> arg -> arg
forall a. Semigroup a => a -> a -> a
<> [arg] -> arg
forall a. Monoid a => [a] -> a
mconcat ((arg -> Text -> arg) -> [arg] -> [Text] -> [arg]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (arg -> Text -> Text -> arg
forall a. With a => a -> Text -> Text -> a
`subtype` Text
t0) [arg]
cs' [Text]
ts)
        )
    mmap :: Text -> [b] -> b
mmap Text
dd' [b]
cs' = b -> (Int -> b) -> Maybe Int -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([b] -> b
forall a. [a] -> a
List.head [b]
cs') ([b]
cs' [b] -> Int -> b
forall a. [a] -> Int -> a
List.!!) (Text -> [Text] -> Maybe Int
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 :: [Text] -> HashMap Text a -> [(Text, a)]
selectItems [Text]
ks HashMap Text a
m =
  HashMap Text a -> [(Text, a)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (HashMap Text a -> [(Text, a)]) -> HashMap Text a -> [(Text, a)]
forall a b. (a -> b) -> a -> b
$
    (Text -> a -> Bool) -> HashMap Text a -> HashMap Text a
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey (\Text
k a
_ -> Text
k Text -> [Text] -> Bool
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 :: [Text] -> [Text] -> SharedRep m [Text]
repItemsSelect [Text]
initial [Text]
full =
  Parser Text
-> (Text -> Text)
-> Maybe Text
-> [Text]
-> [Text]
-> SharedRep m [Text]
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 (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ([Char
','] :: [Char]))) Text -> Text
forall a. a -> a
id (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"items") [Text]
full [Text]
initial

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