{-# language QuasiQuotes #-}

module FlexTask.Widgets where



import Control.Monad.Reader (reader)
import Yesod

import FlexTask.FormUtil (
  newFlexId,
  newFlexName,
  )
import FlexTask.Styling     (horizontalRBStyle)
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
      Lang
ident <- RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang]) Enctype Ints Handler Lang
-> (Lang
    -> RWST
         (Maybe (Env, FileEnv), FlexForm, [Lang]) Enctype Ints Handler Lang)
-> Maybe Lang
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang]) Enctype Ints Handler Lang
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MForm Handler Lang
RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang]) Enctype Ints Handler Lang
newFlexId Lang
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang]) Enctype Ints Handler Lang
forall a.
a
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Lang]) Enctype Ints Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Lang
 -> RWST
      (Maybe (Env, FileEnv), FlexForm, [Lang]) Enctype Ints Handler Lang)
-> Maybe Lang
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [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
      Lang
name <- MForm Handler Lang
RWST
  (Maybe (Env, FileEnv), FlexForm, [Lang]) Enctype Ints Handler Lang
newFlexName
      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)



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 = 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}
|]
      }