{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE IncoherentInstances   #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
{-|
Module: IHP.View.Form.Select
Description: Select and radio form controls
Copyright: (c) digitally induced GmbH, 2020
-}
module IHP.View.Form.Select where

import           GHC.Types
import           IHP.HSX.ConvertibleStrings ()
import           IHP.ModelSupport (InputValue, didTouchField, getModelName, inputValue, isNew)
import           IHP.Prelude
import           IHP.ValidationSupport
import           IHP.View.Classes ()
import           IHP.View.Types

-- | Select inputs require you to pass a list of possible values to select.
--
-- > formFor project [hsx|
-- >     {selectField #userId users}
-- > |]
--
-- In the example above the variable users contains all the possible option values for the select.
--
-- You also need to define a instance @CanSelect User@:
--
-- > instance CanSelect User where
-- >     -- Here we specify that the <option> value should contain a `Id User`
-- >     type SelectValue User = Id User
-- >     -- Here we specify how to transform the model into <option>-value
-- >     selectValue user = user.id
-- >     -- And here we specify the <option>-text
-- >     selectLabel user = user.name
--
-- Given the above example, the rendered form will look like this:
--
-- > <!-- Assuming: users = [User { id = 1, name = "Marc" }, User { id = 2, name = "Andreas" }] -->
-- > <form ...>
-- >     <select name="user_id">
-- >         <option value="1">Marc</option>
-- >         <option value="2">Andreas</option>
-- >     </select>
-- > </form>
--
-- If you want a certain value to be preselected, set the value in the controller. For example, to have the first user be preselected in the above example:
--
-- > action NewProjectAction = do
-- >     users <- query @User |> fetch
-- >     let userId = headMay users |> maybe def (.id)
-- >     let target = newRecord @Project |> set #userId userId
-- >     render NewView { .. }
selectField :: forall fieldName model item.
    ( ?formContext :: FormContext model
    , HasField fieldName model (SelectValue item)
    , HasField "meta" model MetaBag
    , KnownSymbol fieldName
    , KnownSymbol (GetModelName model)
    , CanSelect item
    , InputValue (SelectValue item)
    , Typeable model
    , Eq (SelectValue item)
    , FieldBit fieldName model
    ) => Proxy fieldName -> [item] -> FormField
selectField :: forall (fieldName :: Symbol) model item.
(?formContext::FormContext model,
 HasField fieldName model (SelectValue item),
 HasField "meta" model MetaBag, KnownSymbol fieldName,
 KnownSymbol (GetModelName model), CanSelect item,
 InputValue (SelectValue item), Typeable model,
 Eq (SelectValue item), FieldBit fieldName model) =>
Proxy fieldName -> [item] -> FormField
selectField Proxy fieldName
field [item]
items = FormField
        { fieldType :: InputType
fieldType =
            let
                itemToTuple :: item -> (Text, Text)
                itemToTuple :: item -> (Text, Text)
itemToTuple item
item = (item -> Text
forall model. CanSelect model => model -> Text
selectLabel item
item, SelectValue item -> Text
forall a. InputValue a => a -> Text
inputValue (item -> SelectValue item
forall model. CanSelect model => model -> SelectValue model
selectValue item
item))
            in
                 [(Text, Text)] -> InputType
SelectInput ((item -> (Text, Text)) -> [item] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map item -> (Text, Text)
itemToTuple [item]
items)
        , fieldName :: Text
fieldName = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName
        , fieldLabel :: Text
fieldLabel = Text -> Text
removeIdSuffix (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
fieldNameToFieldLabel (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName)
        -- If the field is not touched, we don't want to render the value from the model
        -- so we force the user to select. If a value was explicitely set in the model, we
        -- render that value.
        , fieldValue :: Text
fieldValue = if Proxy fieldName -> model -> Bool
forall (fieldName :: Symbol) fieldValue record.
(KnownSymbol fieldName, HasField fieldName record fieldValue,
 HasField "meta" record MetaBag, Eq fieldValue, Typeable record,
 FieldBit fieldName record) =>
Proxy fieldName -> record -> Bool
IHP.ModelSupport.didTouchField Proxy fieldName
field model
model Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ model -> Bool
forall model. HasField "meta" model MetaBag => model -> Bool
isNew model
model)
                    then SelectValue item -> Text
forall a. InputValue a => a -> Text
inputValue (forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @fieldName model
model :: SelectValue item)
                    else Text
""
        , fieldInputId :: Text
fieldInputId = Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text
lcfirst (forall model. KnownSymbol (GetModelName model) => Text
getModelName @model) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
fieldName)
        , validatorResult :: Maybe Violation
validatorResult = Proxy fieldName -> model -> Maybe Violation
forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag) =>
Proxy field -> model -> Maybe Violation
getValidationViolation Proxy fieldName
field model
model
        , fieldClass :: Text
fieldClass = Text
""
        , labelClass :: Text
labelClass = Text
""
        , disabled :: Bool
disabled = Bool
False
        , disableLabel :: Bool
disableLabel = Bool
False
        , disableGroup :: Bool
disableGroup = Bool
False
        , disableValidationResult :: Bool
disableValidationResult = Bool
False
        , additionalAttributes :: [(Text, Text)]
additionalAttributes = []
        , cssFramework :: CSSFramework
cssFramework = ?formContext::FormContext model
FormContext model
?formContext.cssFramework
        , helpText :: Text
helpText = Text
""
        , placeholder :: Text
placeholder = Text
"Please select"
        , required :: Bool
required = Bool
False
        , autofocus :: Bool
autofocus = Bool
False
    }
    where
        fieldName :: String
fieldName = Proxy fieldName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy fieldName
field
        FormContext { model
model :: model
model :: forall model. FormContext model -> model
model } = ?formContext::FormContext model
FormContext model
?formContext
{-# INLINE selectField #-}

-- | Radio require you to pass a list of possible values to select. We use the same mechanism as for for 'selectField'.
--
-- > formFor project [hsx|
-- >     {radioField #userId users}
-- > |]
--
-- In the example above the variable users contains all the possible option values for the radios.
--
-- You also need to define a instance @CanSelect User@:
--
-- > instance CanSelect User where
-- >     -- Here we specify that the <option> value should contain a `Id User`
-- >     type SelectValue User = Id User
-- >     -- Here we specify how to transform the model into <option>-value
-- >     selectValue user = user.id
-- >     -- And here we specify the <option>-text
-- >     selectLabel user = user.name
--
-- Given the above example, the rendered form will look like this (omitting classes for brevity):
--
-- > <!-- Assuming: users = [User { id = 1, name = "Marc" }, User { id = 2, name = "Andreas" }] -->
-- > <form ...>
-- >     <fieldset>
-- >         <div>
-- >           <input type="radio" id="option1" value="1"/>
-- >           <label for="option1">Marc</label>
-- >         </div>
-- >         <div>
-- >           <input type="radio" id="option2" value="2"/>
-- >           <label for="option2">Andreas</label>
-- >         </div>
-- >     </fieldset>
-- > </form>
--
-- If you want a certain value to be preselected, set the value in the controller. For example, to have the first user be preselected in the above example:
--
-- > action NewProjectAction = do
-- >     users <- query @User |> fetch
-- >     let userId = headMay users |> maybe def (.id)
-- >     let target = newRecord @Project |> set #userId userId
-- >     render NewView { .. }
radioField :: forall fieldName model item.
    ( ?formContext :: FormContext model
    , HasField fieldName model (SelectValue item)
    , HasField "meta" model MetaBag
    , KnownSymbol fieldName
    , KnownSymbol (GetModelName model)
    , CanSelect item
    , InputValue (SelectValue item)
    , Typeable model
    , Eq (SelectValue item)
    , FieldBit fieldName model
    ) => Proxy fieldName -> [item] -> FormField
radioField :: forall (fieldName :: Symbol) model item.
(?formContext::FormContext model,
 HasField fieldName model (SelectValue item),
 HasField "meta" model MetaBag, KnownSymbol fieldName,
 KnownSymbol (GetModelName model), CanSelect item,
 InputValue (SelectValue item), Typeable model,
 Eq (SelectValue item), FieldBit fieldName model) =>
Proxy fieldName -> [item] -> FormField
radioField Proxy fieldName
field [item]
items = (Proxy fieldName -> [item] -> FormField
forall (fieldName :: Symbol) model item.
(?formContext::FormContext model,
 HasField fieldName model (SelectValue item),
 HasField "meta" model MetaBag, KnownSymbol fieldName,
 KnownSymbol (GetModelName model), CanSelect item,
 InputValue (SelectValue item), Typeable model,
 Eq (SelectValue item), FieldBit fieldName model) =>
Proxy fieldName -> [item] -> FormField
selectField Proxy fieldName
field [item]
items)
    { fieldType =
        let
            itemToTuple :: item -> (Text, Text)
            itemToTuple item
item = (item -> Text
forall model. CanSelect model => model -> Text
selectLabel item
item, SelectValue item -> Text
forall a. InputValue a => a -> Text
inputValue (item -> SelectValue item
forall model. CanSelect model => model -> SelectValue model
selectValue item
item))
        in
                RadioInput (map itemToTuple items)
    , placeholder = ""
    }
{-# INLINE radioField #-}

class CanSelect model where
    -- | Here we specify the type of the @<option>@ value, usually an @Id model@
    type SelectValue model :: GHC.Types.Type

    -- | Here we specify the <option>-text
    selectLabel :: model -> Text
    default selectLabel :: Show model => model -> Text
    selectLabel = model -> Text
forall a. Show a => a -> Text
tshow

    -- | Here we specify how to transform the model into @<option>@-value
    selectValue :: model -> SelectValue model
    default selectValue :: HasField "id" model (SelectValue model) => model -> SelectValue model
    selectValue = (.id)