{-# OPTIONS_GHC -Wno-missing-role-annotations #-}
{-# OPTIONS_GHC -Wno-term-variable-capture #-}

module Dashi.Components.Form where

import Clay hiding
    ( fullWidth
    , legend
    , name
    , not
    , option
    , required
    , selected
    , span_
    , type_
    )
import Clay qualified hiding (not)
import Dashi.Components.Checkbox (CheckboxGroup)
import Dashi.Components.Message
    ( Message (..)
    , MessageIcon (DefaultIcon)
    , MessageSize (FormMessage)
    )
import Dashi.Components.Radio (RadioGroup)
import Dashi.Prelude hiding (has, (#), (&), (**))
import Dashi.Style.Text (TextColour (TextColour))
import Dashi.Style.Tokens
import Dashi.Style.Util
import Miso.Html.Element (fieldset_, label_, legend_, span_)
import Miso.Html.Property (class_, required_)

data FormField w model action = FormField
    { forall w model action.
FormField w model action -> [View model action]
legend :: [View model action]
    , forall w model action. FormField w model action -> Bool
required :: Bool
    , forall w model action. FormField w model action -> w
field :: w
    , forall w model action.
FormField w model action -> [(Appearance, MisoString)]
messages :: [(Appearance, MisoString)]
    }

viewMessage :: (Appearance, MisoString) -> View model action
viewMessage :: forall model action. (Appearance, MisoString) -> View model action
viewMessage (Appearance
appearance, MisoString -> Maybe MisoString
forall a. a -> Maybe a
Just -> Maybe MisoString
secondary) =
    Message -> View model action
forall w model action.
Widget w model action =>
w -> View model action
widget
        Message
            { size :: MessageSize
size = MessageSize
FormMessage
            , icon :: Maybe MessageIcon
icon = MessageIcon -> Maybe MessageIcon
forall a. a -> Maybe a
Just MessageIcon
DefaultIcon
            , title :: Maybe MisoString
title = Maybe MisoString
forall a. Maybe a
Nothing
            , Maybe MisoString
Appearance
appearance :: Appearance
secondary :: Maybe MisoString
secondary :: Maybe MisoString
appearance :: Appearance
..
            }

viewWithLegend
    :: (Widget w model action)
    => [Attribute action]
    -> FormField w model action
    -> View model action
viewWithLegend :: forall w model action.
Widget w model action =>
[Attribute action] -> FormField w model action -> View model action
viewWithLegend [Attribute action]
attrs FormField{w
Bool
[(Appearance, MisoString)]
[View model action]
legend :: forall w model action.
FormField w model action -> [View model action]
required :: forall w model action. FormField w model action -> Bool
field :: forall w model action. FormField w model action -> w
messages :: forall w model action.
FormField w model action -> [(Appearance, MisoString)]
legend :: [View model action]
required :: Bool
field :: w
messages :: [(Appearance, MisoString)]
..} =
    [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
fieldset_ [MisoString -> Attribute action
forall action. MisoString -> Attribute action
class_ MisoString
"form-field"]
        ([View model action] -> View model action)
-> [View model action] -> View model action
forall a b. (a -> b) -> a -> b
$ [[Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
legend_ [] [View model action]
legend | Bool -> Bool
not (Bool -> Bool)
-> ([View model action] -> Bool) -> [View model action] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [View model action] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([View model action] -> Bool) -> [View model action] -> Bool
forall a b. (a -> b) -> a -> b
$ [View model action]
legend]
        [View model action] -> [View model action] -> [View model action]
forall a. Semigroup a => a -> a -> a
<> [[Attribute action] -> w -> View model action
forall w model action.
Widget w model action =>
[Attribute action] -> w -> View model action
widget' ([Bool -> Attribute action
forall action. Bool -> Attribute action
required_ Bool
True | Bool
required] [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. Semigroup a => a -> a -> a
<> [Attribute action]
attrs) w
field]
        [View model action] -> [View model action] -> [View model action]
forall a. Semigroup a => a -> a -> a
<> ((Appearance, MisoString) -> View model action
forall model action. (Appearance, MisoString) -> View model action
viewMessage ((Appearance, MisoString) -> View model action)
-> [(Appearance, MisoString)] -> [View model action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Appearance, MisoString)]
messages)

viewWithLabel
    :: (Widget w model action)
    => [Attribute action]
    -> FormField w model action
    -> View model action
viewWithLabel :: forall w model action.
Widget w model action =>
[Attribute action] -> FormField w model action -> View model action
viewWithLabel [Attribute action]
attrs FormField{w
Bool
[(Appearance, MisoString)]
[View model action]
legend :: forall w model action.
FormField w model action -> [View model action]
required :: forall w model action. FormField w model action -> Bool
field :: forall w model action. FormField w model action -> w
messages :: forall w model action.
FormField w model action -> [(Appearance, MisoString)]
legend :: [View model action]
required :: Bool
field :: w
messages :: [(Appearance, MisoString)]
..} =
    [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
fieldset_ [MisoString -> Attribute action
forall action. MisoString -> Attribute action
class_ MisoString
"form-field"]
        ([View model action] -> View model action)
-> [View model action] -> View model action
forall a b. (a -> b) -> a -> b
$ [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
label_
            []
            ( [[Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
span_ [MisoString -> Attribute action
forall action. MisoString -> Attribute action
class_ MisoString
"legend"] [View model action]
legend | Bool -> Bool
not (Bool -> Bool)
-> ([View model action] -> Bool) -> [View model action] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [View model action] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([View model action] -> Bool) -> [View model action] -> Bool
forall a b. (a -> b) -> a -> b
$ [View model action]
legend]
                [View model action] -> [View model action] -> [View model action]
forall a. Semigroup a => a -> a -> a
<> [[Attribute action] -> w -> View model action
forall w model action.
Widget w model action =>
[Attribute action] -> w -> View model action
widget' ([Bool -> Attribute action
forall action. Bool -> Attribute action
required_ Bool
True | Bool
required] [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. Semigroup a => a -> a -> a
<> [Attribute action]
attrs) w
field]
            )
        View model action -> [View model action] -> [View model action]
forall a. a -> [a] -> [a]
: ((Appearance, MisoString) -> View model action
forall model action. (Appearance, MisoString) -> View model action
viewMessage ((Appearance, MisoString) -> View model action)
-> [(Appearance, MisoString)] -> [View model action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Appearance, MisoString)]
messages)

instance (Widget w model action) => Widget (FormField w model action) model action where
    widget' :: [Attribute action] -> FormField w model action -> View model action
widget' = [Attribute action] -> FormField w model action -> View model action
forall w model action.
Widget w model action =>
[Attribute action] -> FormField w model action -> View model action
viewWithLabel
    style :: Css
style = () -> Css
forall a. a -> StyleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance {-# OVERLAPPING #-} Widget (FormField () model action) model action where
    widget' :: [Attribute action]
-> FormField () model action -> View model action
widget' = [Attribute action]
-> FormField () model action -> View model action
forall w model action.
Widget w model action =>
[Attribute action] -> FormField w model action -> View model action
viewWithLegend
    style :: Css
style = do
        Selector
forall a. IsString a => a
form Selector -> Css -> Css
? do
            Display -> Css
display Display
flex
            FlexDirection -> Css
flexDirection FlexDirection
column
            SizeToken -> Css
gap' SizeToken
Small
            SizeToken -> Css
paddingAll' SizeToken
XSmall
        Selector
".form-field" Selector -> Css -> Css
? do
            Display -> Css
display Display
flex
            FlexDirection -> Css
flexDirection FlexDirection
column
            SizeToken -> Css
rowGap' SizeToken
XSmall
        Selector
Clay.legend Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> (Selector
forall a. IsString a => a
Clay.label Selector -> Selector -> Selector
** Selector
".legend") Selector -> Css -> Css
? do
            Display -> Css
display Display
block
            Css
fullWidth
            FontWeight -> Css
fontWeight (FontWeight -> Css) -> FontWeight -> Css
forall a b. (a -> b) -> a -> b
$ Integer -> FontWeight
weight Integer
500
            SizeToken -> Css
fontSize' SizeToken
Small
            Size LengthUnit -> Css
forall a. Size a -> Css
marginBottom (Size LengthUnit -> Css)
-> (Space -> Size LengthUnit) -> Space -> Css
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Space -> Size LengthUnit
Space -> ValueType Space
forall t.
(Token t, Val (ValueType t), Other (ValueType t)) =>
t -> ValueType t
token (Space -> Css) -> Space -> Css
forall a b. (a -> b) -> a -> b
$ SizeToken -> Space
Space SizeToken
XSmall
        let requiredChild :: Selector
requiredChild = Selector
self Selector -> Refinement -> Selector
# Refinement
Clay.required
        ( Selector
Clay.legend
                # has (self |+ requiredChild)
                Selector -> Selector -> Selector
forall a. Semigroup a => a -> a -> a
<> (Selector
forall a. IsString a => a
Clay.label Selector -> Refinement -> Selector
# Selector -> Refinement
has Selector
requiredChild)
                Selector -> Selector -> Selector
** Selector
".legend"
            )
            Selector -> Css -> Css
? Refinement
after
            Refinement -> Css -> Css
& do
                FontWeight -> Css
fontWeight (FontWeight -> Css) -> FontWeight -> Css
forall a b. (a -> b) -> a -> b
$ Integer -> FontWeight
weight Integer
300
                Content -> Css
content (Content -> Css) -> Content -> Css
forall a b. (a -> b) -> a -> b
$ MisoString -> Content
stringContent MisoString
"*"
                TextColour -> Css
forall t. Token t => t -> Css
color' (TextColour -> Css) -> TextColour -> Css
forall a b. (a -> b) -> a -> b
$ Appearance -> TextColour
TextColour Appearance
Danger
                Size LengthUnit -> Css
forall a. Size a -> Css
marginLeft (Size LengthUnit -> Css)
-> (Space -> Size LengthUnit) -> Space -> Css
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Space -> Size LengthUnit
Space -> ValueType Space
forall t.
(Token t, Val (ValueType t), Other (ValueType t)) =>
t -> ValueType t
token (Space -> Css) -> Space -> Css
forall a b. (a -> b) -> a -> b
$ SizeToken -> Space
Space SizeToken
XSmall

instance
    {-# OVERLAPPING #-}
    (Eq o)
    => Widget (FormField (CheckboxGroup o model action) model action) model action
    where
    widget' :: [Attribute action]
-> FormField (CheckboxGroup o model action) model action
-> View model action
widget' = [Attribute action]
-> FormField (CheckboxGroup o model action) model action
-> View model action
forall w model action.
Widget w model action =>
[Attribute action] -> FormField w model action -> View model action
viewWithLegend
    style :: Css
style = () -> Css
forall a. a -> StyleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance
    {-# OVERLAPPING #-}
    (Eq o)
    => Widget (FormField (RadioGroup o model action) model action) model action
    where
    widget' :: [Attribute action]
-> FormField (RadioGroup o model action) model action
-> View model action
widget' = [Attribute action]
-> FormField (RadioGroup o model action) model action
-> View model action
forall w model action.
Widget w model action =>
[Attribute action] -> FormField w model action -> View model action
viewWithLegend
    style :: Css
style = () -> Css
forall a. a -> StyleM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()