{-# language QuasiQuotes #-}

module FlexTask.Widgets where



import Control.Monad.Reader (reader)
import Yesod

import FlexTask.FormUtil (
  ($$>),
  applyToWidget,
  newFlexId,
  newFlexName,
  repeatFlexName,
  )
import FlexTask.Styling     (horizontalRBStyle)
import FlexTask.YesodConfig (
  FlexForm,
  Handler,
  Rendered,
  Widget,
  )



renderForm
    :: Bool
    -> (FieldSettings FlexForm -> AForm Handler a)
    -> FieldSettings FlexForm
    -> Rendered Widget
renderForm :: forall a.
Bool
-> (FieldSettings FlexForm -> AForm Handler a)
-> FieldSettings FlexForm
-> Rendered (WidgetFor FlexForm ())
renderForm Bool
newId FieldSettings FlexForm -> AForm Handler a
aformStub FieldSettings FlexForm
label =
    (Html -> MForm Handler ([Lang], WidgetFor FlexForm ()))
-> Rendered (WidgetFor FlexForm ())
forall a. (Html -> a) -> ReaderT Html Identity a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader ((Html -> MForm Handler ([Lang], WidgetFor FlexForm ()))
 -> Rendered (WidgetFor FlexForm ()))
-> (Html -> MForm Handler ([Lang], WidgetFor FlexForm ()))
-> Rendered (WidgetFor FlexForm ())
forall a b. (a -> b) -> a -> b
$ \Html
fragment -> do
      Lang
ident <- MForm Handler Lang
RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang]) Enctype Ints Handler Lang
newFlexId
      Lang
name <- if Bool
newId then MForm Handler Lang
RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang]) Enctype Ints Handler Lang
newFlexName else MForm Handler Lang
RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang]) Enctype Ints Handler Lang
repeatFlexName
      let addAttrs :: FieldSettings FlexForm
addAttrs = FieldSettings FlexForm
label {fsName = Just name, fsId = Just ident}
      (FormResult a
_, [FieldView FlexForm] -> [FieldView FlexForm]
views') <- AForm Handler a
-> MForm
     Handler
     (FormResult a, [FieldView FlexForm] -> [FieldView FlexForm])
forall (m :: * -> *) site a.
(Monad m, HandlerSite m ~ site) =>
AForm m a
-> MForm m (FormResult a, [FieldView site] -> [FieldView site])
aFormToForm (AForm Handler a
 -> MForm
      Handler
      (FormResult a, [FieldView FlexForm] -> [FieldView FlexForm]))
-> AForm Handler a
-> MForm
     Handler
     (FormResult a, [FieldView FlexForm] -> [FieldView FlexForm])
forall a b. (a -> b) -> a -> b
$ FieldSettings FlexForm -> AForm Handler a
aformStub FieldSettings FlexForm
addAttrs
      let views :: [FieldView FlexForm]
views = [FieldView FlexForm] -> [FieldView FlexForm]
views' []
      let widget :: WidgetFor FlexForm ()
widget = WidgetFor FlexForm ()
[whamlet|
$newline never
\#{fragment}
$forall view <- views
    <span :fvRequired view:.required :not $ fvRequired view:.optional .flex-form-span>
        <label for=#{fvId view}>#{fvLabel view}
        $maybe tt <- fvTooltip view
            <div .tooltip>#{tt}
        ^{fvInput view}
        $maybe err <- fvErrors view
            <div .errors>#{err}
|]
      ([Lang], WidgetFor FlexForm ())
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([Lang], WidgetFor FlexForm ())
forall a.
a
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang]) Enctype Ints Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Lang
name],WidgetFor FlexForm ()
widget)



joinRenders :: [[Rendered Widget]] -> Rendered Widget
joinRenders :: [[Rendered (WidgetFor FlexForm ())]]
-> Rendered (WidgetFor FlexForm ())
joinRenders = ([ReaderT
    Html
    Identity
    (RWST
       (Maybe (Env, FileEnv), FlexForm, [Lang])
       Enctype
       Ints
       Handler
       ([Lang], WidgetFor FlexForm ()))]
 -> ReaderT
      Html
      Identity
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Lang])
         Enctype
         Ints
         Handler
         ([Lang], WidgetFor FlexForm ()))
 -> ReaderT
      Html
      Identity
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Lang])
         Enctype
         Ints
         Handler
         ([Lang], WidgetFor FlexForm ())))
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor FlexForm ()))
-> [[ReaderT
       Html
       Identity
       (RWST
          (Maybe (Env, FileEnv), FlexForm, [Lang])
          Enctype
          Ints
          Handler
          ([Lang], WidgetFor FlexForm ()))]]
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor FlexForm ()))
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ReaderT
  Html
  Identity
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([Lang], WidgetFor FlexForm ()))
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor FlexForm ()))
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor FlexForm ()))
forall {m :: * -> *} {site} {w} {b}.
(Monad m, ToWidget site w) =>
m (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([Lang], w))
-> m (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor site b))
-> m (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor site b))
joinOuter (ReaderT
   Html
   Identity
   (RWST
      (Maybe (Env, FileEnv), FlexForm, [Lang])
      Enctype
      Ints
      Handler
      ([Lang], WidgetFor FlexForm ()))
 -> ReaderT
      Html
      Identity
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Lang])
         Enctype
         Ints
         Handler
         ([Lang], WidgetFor FlexForm ()))
 -> ReaderT
      Html
      Identity
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Lang])
         Enctype
         Ints
         Handler
         ([Lang], WidgetFor FlexForm ())))
-> ([ReaderT
       Html
       Identity
       (RWST
          (Maybe (Env, FileEnv), FlexForm, [Lang])
          Enctype
          Ints
          Handler
          ([Lang], WidgetFor FlexForm ()))]
    -> ReaderT
         Html
         Identity
         (RWST
            (Maybe (Env, FileEnv), FlexForm, [Lang])
            Enctype
            Ints
            Handler
            ([Lang], WidgetFor FlexForm ())))
-> [ReaderT
      Html
      Identity
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Lang])
         Enctype
         Ints
         Handler
         ([Lang], WidgetFor FlexForm ()))]
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor FlexForm ()))
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor FlexForm ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ReaderT
   Html
   Identity
   (RWST
      (Maybe (Env, FileEnv), FlexForm, [Lang])
      Enctype
      Ints
      Handler
      ([Lang], WidgetFor FlexForm ()))]
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor FlexForm ()))
forall {a}.
[ReaderT
   Html
   Identity
   (RWST
      (Maybe (Env, FileEnv), FlexForm, [Lang])
      Enctype
      Ints
      Handler
      ([Lang], WidgetFor FlexForm a))]
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor FlexForm ()))
joinInner) ReaderT
  Html
  Identity
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([Lang], WidgetFor FlexForm ()))
forall {a}.
ReaderT
  Html
  Identity
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([a], WidgetFor FlexForm ()))
zero
  where
    zero :: ReaderT
  Html
  Identity
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([a], WidgetFor FlexForm ()))
zero = RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang])
  Enctype
  Ints
  Handler
  ([a], WidgetFor FlexForm ())
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([a], WidgetFor FlexForm ()))
forall a. a -> ReaderT Html Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([a], WidgetFor FlexForm ())
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([a], WidgetFor FlexForm ())
forall a.
a
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang]) Enctype Ints Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([],() -> WidgetFor FlexForm ()
forall a. a -> WidgetFor FlexForm a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
    joinInner :: [ReaderT
   Html
   Identity
   (RWST
      (Maybe (Env, FileEnv), FlexForm, [Lang])
      Enctype
      Ints
      Handler
      ([Lang], WidgetFor FlexForm a))]
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor FlexForm ()))
joinInner = (ReaderT
   Html
   Identity
   (RWST
      (Maybe (Env, FileEnv), FlexForm, [Lang])
      Enctype
      Ints
      Handler
      ([Lang], WidgetFor FlexForm a))
 -> ReaderT
      Html
      Identity
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Lang])
         Enctype
         Ints
         Handler
         ([Lang], WidgetFor FlexForm ()))
 -> ReaderT
      Html
      Identity
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Lang])
         Enctype
         Ints
         Handler
         ([Lang], WidgetFor FlexForm ())))
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor FlexForm ()))
-> [ReaderT
      Html
      Identity
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Lang])
         Enctype
         Ints
         Handler
         ([Lang], WidgetFor FlexForm a))]
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor FlexForm ()))
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Rendered' (ReaderT Html Identity) (WidgetFor FlexForm a)
-> Rendered (WidgetFor FlexForm ())
-> Rendered (WidgetFor FlexForm ())
ReaderT
  Html
  Identity
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([Lang], WidgetFor FlexForm a))
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor FlexForm ()))
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor FlexForm ()))
forall (w :: * -> *) (m :: * -> *) a b.
(Monad w, Monad m) =>
Rendered' m (w a) -> Rendered' m (w b) -> Rendered' m (w b)
($$>) ReaderT
  Html
  Identity
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([Lang], WidgetFor FlexForm ()))
forall {a}.
ReaderT
  Html
  Identity
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([a], WidgetFor FlexForm ()))
zero
    joinOuter :: m (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([Lang], w))
-> m (RWST
        (Maybe (Env, FileEnv), FlexForm, [Lang])
        Enctype
        Ints
        Handler
        ([Lang], WidgetFor site b))
-> Rendered' m (WidgetFor site b)
joinOuter m (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([Lang], w))
x m (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([Lang], WidgetFor site b))
y = (w -> WidgetFor site ())
-> Rendered' m w -> Rendered' m (WidgetFor site ())
forall (m :: * -> *) w w'.
Functor m =>
(w -> w') -> Rendered' m w -> Rendered' m w'
applyToWidget w -> WidgetFor site ()
forall {site} {a}. ToWidget site a => a -> WidgetFor site ()
insertDiv Rendered' m w
m (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([Lang], w))
x Rendered' m (WidgetFor site ())
-> Rendered' m (WidgetFor site b) -> Rendered' m (WidgetFor site b)
forall (w :: * -> *) (m :: * -> *) a b.
(Monad w, Monad m) =>
Rendered' m (w a) -> Rendered' m (w b) -> Rendered' m (w b)
$$> Rendered' m (WidgetFor site b)
m (RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang])
     Enctype
     Ints
     Handler
     ([Lang], WidgetFor site b))
y
    insertDiv :: a -> WidgetFor site ()
insertDiv a
w = WidgetFor site ()
[whamlet|
      $newline never
      <div .flex-form-div>
        ^{w}
    |]



horizontalRadioField :: Eq a => Handler (OptionList a) -> Field Handler a
horizontalRadioField :: forall a. Eq a => Handler (OptionList a) -> Field Handler a
horizontalRadioField = (Lang -> WidgetFor FlexForm () -> WidgetFor FlexForm ())
-> (Lang
    -> Lang
    -> Bool
    -> Lang
    -> WidgetFor FlexForm ()
    -> WidgetFor FlexForm ())
-> HandlerFor FlexForm (OptionList a)
-> Field Handler a
forall {a} {site} {site} {site}.
(Eq a, RenderMessage site FormMessage) =>
(Lang -> WidgetFor site () -> WidgetFor site ())
-> (Lang
    -> Lang -> Bool -> Lang -> WidgetFor site () -> WidgetFor site ())
-> HandlerFor site (OptionList a)
-> Field (HandlerFor site) a
withRadioFieldFlat
      (\Lang
theId WidgetFor FlexForm ()
optionWidget -> WidgetFor FlexForm ()
[whamlet|
$newline never
<div .radio>
    <label for=#{theId}-none>
      ^{optionWidget}
      _{MsgSelectNone}
|])
      (\Lang
theId Lang
value Bool
_isSel Lang
text WidgetFor FlexForm ()
optionWidget -> WidgetFor FlexForm ()
[whamlet|
$newline never
<label for=#{theId}-#{value}>
  ^{optionWidget}
  \#{text}
|])
  where
    withRadioFieldFlat :: (Lang -> WidgetFor site () -> WidgetFor site ())
-> (Lang
    -> Lang -> Bool -> Lang -> WidgetFor site () -> WidgetFor site ())
-> HandlerFor site (OptionList a)
-> Field (HandlerFor site) a
withRadioFieldFlat Lang -> WidgetFor site () -> WidgetFor site ()
nothingFun Lang
-> Lang -> Bool -> Lang -> WidgetFor site () -> WidgetFor site ()
optFun =
      (Lang
 -> Lang
 -> [(Lang, Lang)]
 -> WidgetFor site ()
 -> WidgetFor site ())
-> (Lang -> Lang -> Bool -> WidgetFor site ())
-> (Lang
    -> Lang
    -> [(Lang, Lang)]
    -> Lang
    -> Bool
    -> Lang
    -> WidgetFor site ())
-> Maybe (Lang -> WidgetFor site ())
-> HandlerFor site (OptionList a)
-> Field (HandlerFor site) a
forall a site.
(Eq a, RenderMessage site FormMessage) =>
(Lang
 -> Lang
 -> [(Lang, Lang)]
 -> WidgetFor site ()
 -> WidgetFor site ())
-> (Lang -> Lang -> Bool -> WidgetFor site ())
-> (Lang
    -> Lang
    -> [(Lang, Lang)]
    -> Lang
    -> Bool
    -> Lang
    -> WidgetFor site ())
-> Maybe (Lang -> WidgetFor site ())
-> HandlerFor site (OptionList a)
-> Field (HandlerFor site) a
selectFieldHelper Lang
-> Lang -> [(Lang, Lang)] -> WidgetFor site () -> WidgetFor site ()
forall {a} {site} {a} {p} {p}.
(ToMarkup a, ToWidget site a) =>
a -> p -> p -> a -> WidgetFor site ()
outside Lang -> Lang -> Bool -> WidgetFor site ()
forall {a}. ToMarkup a => Lang -> a -> Bool -> WidgetFor site ()
onOpt Lang
-> Lang
-> [(Lang, Lang)]
-> Lang
-> Bool
-> Lang
-> WidgetFor site ()
forall {a} {a}.
(ToMarkup a, ToAttributes a) =>
Lang -> a -> a -> Lang -> Bool -> Lang -> WidgetFor site ()
inside Maybe (Lang -> WidgetFor site ())
forall a. Maybe a
Nothing
        where
          outside :: a -> p -> p -> a -> WidgetFor site ()
outside a
theId p
_name p
_attrs a
inside' =
            (RY site -> Css) -> WidgetFor site ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ site) =>
(RY site -> Css) -> m ()
toWidget RY site -> Css
forall render. render -> Css
horizontalRBStyle WidgetFor site () -> WidgetFor site () -> WidgetFor site ()
forall a b.
WidgetFor site a -> WidgetFor site b -> WidgetFor site b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WidgetFor site ()
[whamlet|
$newline never
<div>
  <span ##{theId}>^{inside'}
|]
          onOpt :: Lang -> a -> Bool -> WidgetFor site ()
onOpt Lang
theId a
name Bool
isSel = Lang -> WidgetFor site () -> WidgetFor site ()
nothingFun Lang
theId WidgetFor site ()
[whamlet|
$newline never
<input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>
|]
          inside :: Lang -> a -> a -> Lang -> Bool -> Lang -> WidgetFor site ()
inside Lang
theId a
name a
attrs Lang
value Bool
isSel Lang
display =
            Lang
-> Lang -> Bool -> Lang -> WidgetFor site () -> WidgetFor site ()
optFun Lang
theId Lang
value Bool
isSel Lang
display WidgetFor site ()
[whamlet|
<input id=#{theId}-#{(value)} type=radio name=#{name} value=#{(value)} :isSel:checked *{attrs}>
|]



checkboxField :: Eq a => Bool -> Handler (OptionList a) -> Field Handler [a]
checkboxField :: forall a.
Eq a =>
Bool -> Handler (OptionList a) -> Field Handler [a]
checkboxField Bool
isVertical Handler (OptionList a)
optList = (Handler (OptionList a) -> Field Handler [a]
forall a site.
Eq a =>
HandlerFor site (OptionList a) -> Field (HandlerFor site) [a]
multiSelectField Handler (OptionList a)
optList)
      { fieldView =
          \Lang
theId Lang
title [(Lang, Lang)]
attrs Either Lang [a]
val Bool
_isReq -> do
              [Option a]
os <- OptionList a -> [Option a]
forall a. OptionList a -> [Option a]
olOptions (OptionList a -> [Option a])
-> WidgetFor FlexForm (OptionList a)
-> WidgetFor FlexForm [Option a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler (OptionList a) -> WidgetFor FlexForm (OptionList a)
forall site a. HandlerFor site a -> WidgetFor site a
handlerToWidget Handler (OptionList a)
optList
              let selected :: Either a (t a) -> Option a -> Bool
selected (Left a
_) Option a
_ = Bool
False
                  selected (Right t a
values) Option a
opt = Option a -> a
forall a. Option a -> a
optionInternalValue Option a
opt a -> t a -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
values
                  checkboxWidget :: Option a -> WidgetFor site ()
checkboxWidget Option a
opt = WidgetFor site ()
[whamlet|
<label>
  <input type=checkbox name=#{title} value=#{optionExternalValue opt} *{attrs} :selected val opt:checked>
  #{optionDisplay opt}
|]
              WidgetFor FlexForm ()
[whamlet|
<span ##{theId}>
  <input type=hidden name=#{title} value=0>
  $forall opt <- os
    $with box <- checkboxWidget opt
      $if isVertical
        <div>
          ^{box}
      $else
        ^{box}
|]
      }