{-# language QuasiQuotes #-}

module FlexTask.Widgets where



import Control.Monad.Reader (reader)
import Yesod

import FlexTask.FormUtil (
  newFlexId,
  newFlexName,
  )
import FlexTask.Styling     (horizontalRBStyle, checkboxStyle)
import FlexTask.YesodConfig (
  FlexForm,
  Handler,
  Rendered,
  Widget,
  )



renderForm
    :: (FieldSettings FlexForm -> AForm Handler a)
    -> FieldSettings FlexForm
    -> Rendered Widget
renderForm :: forall a.
(FieldSettings FlexForm -> AForm Handler a)
-> FieldSettings FlexForm -> Rendered (WidgetFor FlexForm ())
renderForm FieldSettings FlexForm -> AForm Handler a
aformStub FieldSettings FlexForm
label =
    (MarkupM () -> MForm Handler ([[Lang]], WidgetFor FlexForm ()))
-> Rendered (WidgetFor FlexForm ())
forall a. (MarkupM () -> a) -> ReaderT (MarkupM ()) Identity a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader ((MarkupM () -> MForm Handler ([[Lang]], WidgetFor FlexForm ()))
 -> Rendered (WidgetFor FlexForm ()))
-> (MarkupM () -> MForm Handler ([[Lang]], WidgetFor FlexForm ()))
-> Rendered (WidgetFor FlexForm ())
forall a b. (a -> b) -> a -> b
$ \MarkupM ()
fragment -> do
      ident <- RWST
  (Maybe (Env, FileEnv), HandlerSite Handler, [Lang])
  Enctype
  Ints
  Handler
  Lang
-> (Lang
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite Handler, [Lang])
         Enctype
         Ints
         Handler
         Lang)
-> Maybe Lang
-> RWST
     (Maybe (Env, FileEnv), HandlerSite Handler, [Lang])
     Enctype
     Ints
     Handler
     Lang
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RWST
  (Maybe (Env, FileEnv), HandlerSite Handler, [Lang])
  Enctype
  Ints
  Handler
  Lang
newFlexId Lang
-> RWST
     (Maybe (Env, FileEnv), HandlerSite Handler, [Lang])
     Enctype
     Ints
     Handler
     Lang
forall a.
a
-> RWST
     (Maybe (Env, FileEnv), HandlerSite Handler, [Lang])
     Enctype
     Ints
     Handler
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Lang
 -> RWST
      (Maybe (Env, FileEnv), HandlerSite Handler, [Lang])
      Enctype
      Ints
      Handler
      Lang)
-> Maybe Lang
-> RWST
     (Maybe (Env, FileEnv), HandlerSite Handler, [Lang])
     Enctype
     Ints
     Handler
     Lang
forall a b. (a -> b) -> a -> b
$ FieldSettings FlexForm -> Maybe Lang
forall master. FieldSettings master -> Maybe Lang
fsId FieldSettings FlexForm
label
      name <- newFlexName
      let addAttrs = FieldSettings FlexForm
label {fsName = Just name, fsId = Just ident}
      (_, views') <- aFormToForm $ aformStub addAttrs
      let views = [FieldView FlexForm] -> [FieldView FlexForm]
views' []
      let widget = [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}
|]
      return ([[name]],widget)



joinWidgets :: [[Widget]] -> Widget
joinWidgets :: [[WidgetFor FlexForm ()]] -> WidgetFor FlexForm ()
joinWidgets = ([WidgetFor FlexForm ()] -> WidgetFor FlexForm ())
-> [[WidgetFor FlexForm ()]] -> WidgetFor FlexForm ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WidgetFor FlexForm () -> WidgetFor FlexForm ()
forall {site} {a}. ToWidget site a => a -> WidgetFor site ()
insertDiv (WidgetFor FlexForm () -> WidgetFor FlexForm ())
-> ([WidgetFor FlexForm ()] -> WidgetFor FlexForm ())
-> [WidgetFor FlexForm ()]
-> WidgetFor FlexForm ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WidgetFor FlexForm ()] -> WidgetFor FlexForm ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_)
  where
    insertDiv :: a -> WidgetFor site ()
insertDiv a
w = [whamlet|
      $newline never
      <div .flex-form-div .form-group>
        ^{w}
    |]



radioField :: Eq a => Bool -> Handler (OptionList a) -> Field Handler a
radioField :: forall a. Eq a => Bool -> Handler (OptionList a) -> Field Handler a
radioField Bool
isVertical = (Lang
 -> Lang
 -> [(Lang, Lang)]
 -> WidgetFor FlexForm ()
 -> WidgetFor FlexForm ())
-> (Lang -> Lang -> Bool -> WidgetFor FlexForm ())
-> (Lang
    -> Lang
    -> [(Lang, Lang)]
    -> Lang
    -> Bool
    -> Lang
    -> WidgetFor FlexForm ())
-> Maybe (Lang -> WidgetFor FlexForm ())
-> HandlerFor FlexForm (OptionList a)
-> Field Handler 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 FlexForm ()
-> WidgetFor FlexForm ()
forall {a} {site} {a} {p} {p}.
(ToMarkup a, ToWidget site a) =>
a -> p -> p -> a -> WidgetFor site ()
outside Lang -> Lang -> Bool -> WidgetFor FlexForm ()
forall {site} {a} {a}.
(RenderMessage site FormMessage, ToMarkup a, ToMarkup a) =>
a -> a -> Bool -> WidgetFor site ()
onOpt Lang
-> Lang
-> [(Lang, Lang)]
-> Lang
-> Bool
-> Lang
-> WidgetFor FlexForm ()
forall {p} {p} {p} {p} {p} {site}.
(ToAttributes p, ToMarkup p, ToMarkup p, ToMarkup p, ToMarkup p) =>
p -> p -> p -> p -> Bool -> p -> WidgetFor site ()
inside Maybe (Lang -> WidgetFor FlexForm ())
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
>> [whamlet|
$newline never
<div>
  <span ##{theId}>^{inside'}
|]
    onOpt :: a -> a -> Bool -> WidgetFor site ()
onOpt a
theId a
name Bool
isSel = a -> WidgetFor site () -> WidgetFor site ()
forall {site} {p} {p}.
(ToWidget site p, RenderMessage site FormMessage) =>
p -> p -> WidgetFor site ()
nothingFun a
theId [whamlet|
$newline never
<input id=#{theId}-none type=radio name=#{name} value="None" :isSel:checked>
|]
    nothingFun :: p -> p -> WidgetFor site ()
nothingFun p
_ p
optionWidget =
      let emptyRadio :: WidgetFor site ()
emptyRadio = [whamlet|
$newline never
<label>
  ^{optionWidget}
  _{MsgSelectNone}
|]
      in [whamlet|
$newline never
$if isVertical
  <div>
    ^{emptyRadio}
$else
  ^{emptyRadio}
|]
    inside :: p -> p -> p -> p -> Bool -> p -> WidgetFor site ()
inside p
theId p
name p
attrs p
value Bool
isSel p
display =
      let radio :: WidgetFor site ()
radio = [whamlet|
$newline never
<label>
  <input id=#{theId}-#{(value)} type=radio name=#{name} value=#{(value)} :isSel:checked *{attrs}>
  \#{display}
|]
      in [whamlet|
$newline never
$if isVertical
  <div>
    ^{radio}
$else
  ^{radio}
|]



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
              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 (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
opt = [whamlet|
<label>
  <input type=checkbox name=#{title} value=#{optionExternalValue opt} *{attrs} :selected val opt:checked>
  #{optionDisplay opt}
|]
              toWidget checkboxStyle >> [whamlet|
<div ##{theId}>
  <input type=hidden name=#{title} value=0>
  $forall opt <- os
    $with box <- checkboxWidget opt
      $if isVertical
        <div>
          ^{box}
      $else
        ^{box}
|]
      }


selectField
  :: (Eq a, RenderMessage site FormMessage)
  => Bool
  -> HandlerFor site (OptionList a)
  -> Field (HandlerFor site) a
selectField :: forall a site.
(Eq a, RenderMessage site FormMessage) =>
Bool -> HandlerFor site (OptionList a) -> Field (HandlerFor site) a
selectField Bool
req = (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
theId Lang
name [(Lang, Lang)]
attrs WidgetFor site ()
inside -> [whamlet|
$newline never
<select ##{theId} name=#{name} :req:required *{attrs}>
  $if req
    <option value="" selected disabled>_{MsgSelectNone}
  ^{inside}
|]) -- outside
    (\Lang
_theId Lang
_name Bool
isSel -> [whamlet|
$newline never
<option value="None" :isSel:selected>_{MsgSelectNone}
|]) -- when optional
    (\Lang
_theId Lang
_name [(Lang, Lang)]
_attrs Lang
value Bool
isSel Lang
text -> WidgetFor site () -> WidgetFor site ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ site) =>
WidgetFor site () -> m ()
toWidget [whamlet|
$newline never
<option value=#{value} :isSel:selected>#{text}
|]) -- inside
    ((Lang -> WidgetFor site ()) -> Maybe (Lang -> WidgetFor site ())
forall a. a -> Maybe a
Just ((Lang -> WidgetFor site ()) -> Maybe (Lang -> WidgetFor site ()))
-> (Lang -> WidgetFor site ()) -> Maybe (Lang -> WidgetFor site ())
forall a b. (a -> b) -> a -> b
$ \Lang
label -> [whamlet|
<optgroup label=#{label}>
|]) -- group label