{-# LANGUAGE FlexibleContexts #-}

module Yesod.Form.Option where

import Yesod.Core
import Yesod.Form.Fields

-- | Creates an `OptionList` from a `List`, using the `PathPiece` instance for
-- the external value and a custom function for the user-facing value.
--
-- @since 1.7.7
--
-- PathPiece instances should provide suitable external values, since path
-- pieces serve to be exposed through URLs or HTML anyway. Show/Read instances
-- are avoided here since they could leak internal representations to forms,
-- query params, javascript etc.
--
-- === __Example usage__
--
-- > data UserRole = URSalesTeam | URSalesHead | URTechTeam | URTechHead
-- >
-- > instance PathPiece UserDepartment where
-- >   toPathPiece = \case
-- >     URSalesTeam -> "sales-team"
-- >     URSalesHead -> "sales-head"
-- >     URTechTeam -> "tech-team"
-- >     URTechHead -> "tech-head"
-- >   fromPathPiece = \case
-- >     "sales-team" -> Just URSalesTeam
-- >     "sales-head" -> Just URSalesHead
-- >     "tech-team" -> Just URTechTeam
-- >     "tech-head" -> Just URTechHead
-- >     _ -> Nothing
-- >
-- > userRoleOptions ::
-- >   (MonadHandler m, RenderMessage (HandlerSite m) msg) => m (OptionList UserRole)
-- > userRoleOptions = optionsFromList' userRoles toMsg
-- >   where
-- >   userRoles = [URSalesTeam, URSalesHead, URTechTeam, URTechHead]
-- >   toMsg :: UserRole -> Text
-- >   toMsg = \case
-- >     URSalesTeam -> "Sales Team"
-- >     URSalesHead -> "Head of Sales Team"
-- >     URTechTeam -> "Tech Team"
-- >     URTechHead -> "Head of Tech Team"
--
-- userRoleOptions, will produce an OptionList with the following attributes:
--
-- > +----------------+----------------+--------------------+
-- > | Internal Value | External Value | User-facing Value  |
-- > +----------------+----------------+--------------------+
-- > | URSalesTeam    | sales-team     | Sales Team         |
-- > +----------------+----------------+--------------------+
-- > | URSalesHead    | sales-head     | Head of Sales Team |
-- > +----------------+----------------+--------------------+
-- > | URTechTeam     | tech-team      | Tech Team          |
-- > +----------------+----------------+--------------------+
-- > | URTechHead     | tech-head      | Head of Tech Team  |
-- > +----------------+----------------+--------------------+
--
-- Note that the type constraint allows localizable messages in place of toMsg (see
-- https://en.wikipedia.org/wiki/Yesod_(web_framework)#Localizable_messages).

optionsFromList' ::
     MonadHandler m
  => RenderMessage (HandlerSite m) msg
  => PathPiece a
  => [a]
  -> (a -> msg)
  -> m (OptionList a)
optionsFromList' :: forall (m :: * -> *) msg a.
(MonadHandler m, RenderMessage (HandlerSite m) msg, PathPiece a) =>
[a] -> (a -> msg) -> m (OptionList a)
optionsFromList' [a]
lst a -> msg
toDisplay = do
  msg -> Text
mr <- m (msg -> Text)
forall (m :: * -> *) message.
(MonadHandler m, RenderMessage (HandlerSite m) message) =>
m (message -> Text)
getMessageRender
  OptionList a -> m (OptionList a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OptionList a -> m (OptionList a))
-> OptionList a -> m (OptionList a)
forall a b. (a -> b) -> a -> b
$ [Option a] -> OptionList a
forall a. [Option a] -> OptionList a
mkOptionList ([Option a] -> OptionList a) -> [Option a] -> OptionList a
forall a b. (a -> b) -> a -> b
$ ((a -> Option a) -> [a] -> [Option a])
-> [a] -> (a -> Option a) -> [Option a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Option a) -> [a] -> [Option a]
forall a b. (a -> b) -> [a] -> [b]
map [a]
lst ((a -> Option a) -> [Option a]) -> (a -> Option a) -> [Option a]
forall a b. (a -> b) -> a -> b
$ \a
v -> Option
    { optionDisplay :: Text
optionDisplay = msg -> Text
mr (msg -> Text) -> msg -> Text
forall a b. (a -> b) -> a -> b
$ a -> msg
toDisplay a
v
    , optionInternalValue :: a
optionInternalValue = a
v
    , optionExternalValue :: Text
optionExternalValue = a -> Text
forall s. PathPiece s => s -> Text
toPathPiece a
v
    }

-- | Creates an `OptionList` from an `Enum`.
--
-- @since 1.7.7
--
-- optionsEnum' == optionsFromList' [minBound..maxBound]
--
-- Creates an `OptionList` containing every constructor of `a`, so that these
-- constructors do not need to be typed out. Bounded and Enum instances must
-- exist for `a` to use this.
optionsEnum' ::
     MonadHandler m
  => RenderMessage (HandlerSite m) msg
  => PathPiece a
  => Enum a
  => Bounded a
  => (a -> msg)
  -> m (OptionList a)
optionsEnum' :: forall (m :: * -> *) msg a.
(MonadHandler m, RenderMessage (HandlerSite m) msg, PathPiece a,
 Enum a, Bounded a) =>
(a -> msg) -> m (OptionList a)
optionsEnum' = [a] -> (a -> msg) -> m (OptionList a)
forall (m :: * -> *) msg a.
(MonadHandler m, RenderMessage (HandlerSite m) msg, PathPiece a) =>
[a] -> (a -> msg) -> m (OptionList a)
optionsFromList' [a
forall a. Bounded a => a
minBound..a
forall a. Bounded a => a
maxBound]